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