VBA - 交换单元格直到满足条件
VBA - Swapping cells until condition is met
我是 vba 的新手,无法通过条件循环交换单元格。
我有一个 table 看起来像
并想将其转换(将数字单元格移至 b 列并删除非数字值)为
现在我有代码
Sub Swap()
With ThisWorkbook.Sheets("Sheet1")
For j = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If IsNumeric(.Cells(j, 2)) = False Then
For k = 2 To .Cells(j, Columns.Count).End(xlToLeft).Columns
Do Until IsNumeric(.Cells(j, 2)) = True
t = .Cells(j, k)
.Cells(j, k) = .Cells(j, k + 1)
.Cells(j, k + 1) = t
Loop
Next k
Else
End If
Next j
End With
End Sub
在第 9 行之前工作正常,它在无限循环中不断交换 B9 和 C9。
希望有人能帮帮我
…它正在完全你告诉它做什么。
您对 B9 进行了 Do Until
检查,将其与单元格 C9 交换。所以,它以“ee”开头,然后你交换它们。现在是“e”,所以你交换它们。又是“ee”,所以它又交换了它们。重复广告令人作呕
你需要重新考虑 Do Until
。粗略的蛮力方法是 Delete
具有“左移”参数的单元格。另一种方法是将 For k = 2..
循环 放在 Do Until
循环的 内部,而不是相反。
当算法到达第 9 行时,它会陷入循环,因为单元格 2 和 3 都是非数字 (e, ee),并且您要将它们交换到无穷大...
最好对每一行执行以下步骤:
1-遍历整个行的单元格以找到数字一并复制它
2- 清理所有不需要的单元格并使它们空白
3- 用复制的数字填充行的第二个单元格
4- 完成!
条件循环
Option Explicit
Sub Swap()
Dim rg As Range
With ThisWorkbook.Sheets("Sheet1")
Dim lCell As Range
Dim lRow As Long
With .UsedRange
Set lCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
If lCell Is Nothing Then Exit Sub
lRow = lCell.Row
Set lCell = .Find("*", , xlFormulas, , xlByColumns, xlPrevious)
End With
Set rg = .Range("B1", .Cells(lRow, lCell.Column))
End With
Dim Data As Variant: Data = rg.Value
Dim rCount As Long: rCount = UBound(Data, 1)
Dim cCount As Long: cCount = UBound(Data, 2)
Dim cValue As Variant
Dim r As Long
Dim c As Long
Dim NumberFound As Boolean
For r = 1 To rCount
For c = 1 To cCount
cValue = Data(r, c)
If VarType(cValue) = vbDouble Then
NumberFound = True
Exit For
End If
Next c
If NumberFound Then
Data(r, 1) = cValue
NumberFound = False
Else
Data(r, 1) = Empty ' no number found
End If
For c = 2 To cCount
Data(r, c) = Empty
Next c
Next r
rg.Value = Data
End Sub
下面的代码使用 Excel 的 MAX 函数,因为它会愉快地忽略范围内的任何 non-numeric 数据,并简单地 return (单个)数字数据(到变量 数量):
Sub unConditional()
Dim lastRow As Long, i As Long, number As Long, dataRow As Range
With Worksheets("Sheet1")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
Set dataRow = .Cells(i, 2).Resize(1, .Cells(i, 1).End(xlToRight).Column - 1)
number = WorksheetFunction.Max(dataRow)
dataRow.ClearContents
.Cells(i, 2).Value2 = number
Next i
End With
End Sub
我是 vba 的新手,无法通过条件循环交换单元格。
我有一个 table 看起来像
并想将其转换(将数字单元格移至 b 列并删除非数字值)为
现在我有代码
Sub Swap()
With ThisWorkbook.Sheets("Sheet1")
For j = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If IsNumeric(.Cells(j, 2)) = False Then
For k = 2 To .Cells(j, Columns.Count).End(xlToLeft).Columns
Do Until IsNumeric(.Cells(j, 2)) = True
t = .Cells(j, k)
.Cells(j, k) = .Cells(j, k + 1)
.Cells(j, k + 1) = t
Loop
Next k
Else
End If
Next j
End With
End Sub
在第 9 行之前工作正常,它在无限循环中不断交换 B9 和 C9。
希望有人能帮帮我
…它正在完全你告诉它做什么。
您对 B9 进行了 Do Until
检查,将其与单元格 C9 交换。所以,它以“ee”开头,然后你交换它们。现在是“e”,所以你交换它们。又是“ee”,所以它又交换了它们。重复广告令人作呕
你需要重新考虑 Do Until
。粗略的蛮力方法是 Delete
具有“左移”参数的单元格。另一种方法是将 For k = 2..
循环 放在 Do Until
循环的 内部,而不是相反。
当算法到达第 9 行时,它会陷入循环,因为单元格 2 和 3 都是非数字 (e, ee),并且您要将它们交换到无穷大... 最好对每一行执行以下步骤: 1-遍历整个行的单元格以找到数字一并复制它 2- 清理所有不需要的单元格并使它们空白 3- 用复制的数字填充行的第二个单元格 4- 完成!
条件循环
Option Explicit
Sub Swap()
Dim rg As Range
With ThisWorkbook.Sheets("Sheet1")
Dim lCell As Range
Dim lRow As Long
With .UsedRange
Set lCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
If lCell Is Nothing Then Exit Sub
lRow = lCell.Row
Set lCell = .Find("*", , xlFormulas, , xlByColumns, xlPrevious)
End With
Set rg = .Range("B1", .Cells(lRow, lCell.Column))
End With
Dim Data As Variant: Data = rg.Value
Dim rCount As Long: rCount = UBound(Data, 1)
Dim cCount As Long: cCount = UBound(Data, 2)
Dim cValue As Variant
Dim r As Long
Dim c As Long
Dim NumberFound As Boolean
For r = 1 To rCount
For c = 1 To cCount
cValue = Data(r, c)
If VarType(cValue) = vbDouble Then
NumberFound = True
Exit For
End If
Next c
If NumberFound Then
Data(r, 1) = cValue
NumberFound = False
Else
Data(r, 1) = Empty ' no number found
End If
For c = 2 To cCount
Data(r, c) = Empty
Next c
Next r
rg.Value = Data
End Sub
下面的代码使用 Excel 的 MAX 函数,因为它会愉快地忽略范围内的任何 non-numeric 数据,并简单地 return (单个)数字数据(到变量 数量):
Sub unConditional()
Dim lastRow As Long, i As Long, number As Long, dataRow As Range
With Worksheets("Sheet1")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
Set dataRow = .Cells(i, 2).Resize(1, .Cells(i, 1).End(xlToRight).Column - 1)
number = WorksheetFunction.Max(dataRow)
dataRow.ClearContents
.Cells(i, 2).Value2 = number
Next i
End With
End Sub