Question

删除随机放置在电子表格中的空白单元格的VBA代码是什么？输入

ColA   ColB   ColC   ColD   ColE
 A             B             D
 H      J             I
 F             B             O

输出应该是：

ColA   ColB   ColC   ColD   ColE
 A      B      D
 H      J      I
 F      B      O

Answer 1

此解决方案速度非常快，并且没有我在OP问题下面的评论中列出的三个警告：

Public Sub CullValues()
    Dim i&, j&, k&, v
    v = ActiveSheet.UsedRange
    For i = 1 To UBound(v, 1)
        k = 0
        For j = 1 To UBound(v, 2)
            If Len(v(i, j)) Then
                k = k + 1
                v(i, k) = v(i, j)
                If j > k Then v(i, j) = Empty
            End If
        Next
    Next
    [a1].Resize(UBound(v, 1), UBound(v, 2)) = v
End Sub

Answer 2

你应该至少尝试自己编写代码。

那就是说，下面是一个有效的解决方案。

Option Explicit
Sub remove_blanks()
    Dim lrow As Long, lcol As Long, i As Long, j As Long, k As Long, r As Long
    Dim arrData() As Variant
    Dim wb As Workbook, ws As Worksheet, myrng As Range

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    ' Range can be made dynamic
    Set myrng = ws.Range("A1:BR103068")

    arrData = myrng.Value

    For i = LBound(arrData, 1) To UBound(arrData, 1)
        r = 0
        For j = LBound(arrData, 2) To UBound(arrData, 2)
            If arrData(i, j) = Empty Then
                For k = j To UBound(arrData, 2) - 1
                    arrData(i, k) = arrData(i, k + 1)
                Next k

                ' Last element emptied after first loop
                If k = UBound(arrData, 2) And r = 0 Then
                    arrData(i, k + r) = Empty
                End If
                r = r + 1 ' counts how many empty elements removed
            End If

            ' Exits loop after spaces removed from iteration
            If j + r = UBound(arrData, 2) Then
                Exit For
            End If

            ' Accounts for consecutive empty array elements
            If arrData(i, j) = Empty Then
                j = j - 1
            End If
        Next j
    Next i

    myrng.ClearContents
    myrng.Value = arrData
End Sub

我还没有测试过@Excel Hero，但是当它找到一个空元素时，它看起来并不像是将所有元素都移动到数组中。下面将移动所有元素，然后迭代到下一个空元素，直到它到达评估该项目中所有元素的点。

对70列和100,000行数据进行测试，代码需要80秒才能完成。

VBA代码从工作表中删除随机空白单元格

2 个答案: