VBA 从 sheet 中删除随机空白单元格的代码

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

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

也就是说，下面是一个可行的解决方案。

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's，但它看起来不像是在找到空元素时将所有元素向上移动数组。下面将移动所有元素，然后迭代到下一个空元素，直到到达该项目中所有元素都已评估的点。

Testing on 70 columns and 100,000 rows of data, the code took 80 seconds to complete.

VBA 从 sheet 中删除随机空白单元格的代码

VBA code to remove random blank cells from a sheet

excel

vba

deduplication