VBA Sub 从行改进中删除空白

Question

我写了一个子程序来删除一行中的空白条目而不移动单元格，但它似乎不必要地笨重，我想就如何改进它获得一些建议。

Public Sub removeBlankEntriesFromRow(inputRow As Range, pasteLocation As String)
    'Removes blank entries from inputRow and pastes the result into a row starting at cell pasteLocation

    Dim oldArray, newArray, tempArray
    Dim j As Integer
    Dim i As Integer

    'dump range into temp array
    tempArray = inputRow.Value
    'redim the 1d array
    ReDim oldArray(1 To UBound(tempArray, 2))
    'convert from 2d to 1d
    For i = 1 To UBound(oldArray, 1)
        oldArray(i) = tempArray(1, i)
    Next
    'redim the newArray
    ReDim newArray(LBound(oldArray) To UBound(oldArray))
    'for each not blank in oldarray, fill into newArray
    For i = LBound(oldArray) To UBound(oldArray)
        If oldArray(i) <> "" Then
            j = j + 1
            newArray(j) = oldArray(i)
        End If
    Next
    'Catch Error
    If j <> 0 Then
        'redim the newarray to the correct size.
        ReDim Preserve newArray(LBound(oldArray) To j)
        'clear the old row
        inputRow.ClearContents
        'paste the array into a row starting at pasteLocation
        Range(pasteLocation).Resize(1, j - LBound(newArray) + 1) = (newArray)
    End If
End Sub

Answer 1

如果我理解您想删除空白并将数据拉到任何给定行上？

我会通过将数组转换为与管道 | 连接的字符串，清除所有双管道（循环此操作直到没有双精度），然后将其推回跨行的数组：

这是我的代码：

Sub TestRemoveBlanks()
    Call RemoveBlanks(Range("A1"))
End Sub

Sub RemoveBlanks(Target As Range)
    Dim MyString As String
    MyString = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range(Target.Row & ":" & Target.Row))), "|")
    Do Until Len(MyString) = Len(Clean(MyString))
        MyString = Clean(MyString)
    Loop
    Rows(Target.Row).ClearContents
    Target.Resize(1, Len(MyString) - Len(Replace(MyString, "|", ""))).Formula = Split(MyString, "|")
End Sub

Function Clean(MyStr As String)
    Clean = Replace(MyStr, "||", "|")
End Function

我在里面放了一个替你测试。

如果您的数据中有管道，请将其替换为我的代码中的其他内容。

Answer 2

这是我对您描述的任务的看法：

Option Explicit
Option Base 0

Public Sub removeBlankEntriesFromRow(inputRow As Range, pasteLocation As String)
    'Removes blank entries from inputRow and pastes the result into a row starting at cell pasteLocation
    Dim c As Range
    Dim i As Long
    Dim new_array As String(inputRow.Cells.Count - WorksheetFunction.CountBlank(inputRow))

    For Each c In inputRow
        If c.Value <> vbNullString Then
            inputRow(i) = c.Value
            i = i + 1
        End If
    Next

    Range(pasteLocation).Resize(1, i - 1) = (new_array)
End Sub

您会注意到它完全不同，虽然它可能比您的解决方案稍慢，因为它使用 for each-loop 而不是循环遍历数组，如果我对 this answer 的阅读是正确的，除非输入范围非常大，否则应该没那么重要。

如您所见，它明显更短，并且 我 发现它更易于阅读 - 尽管与您的语法相反，这可能只是对这种语法的熟悉。不幸的是，我不在我的工作电脑自动取款机上。测试它，但我认为它应该做你想要的。

如果您的主要目标是提高代码的性能，我认为查看在代码运行时您可以关闭哪些设置将比您使用哪种循环和变量赋值更有效。我发现this blog 很好地介绍了在 VBA 中编码时要记住的一些概念。

我希望您发现我对您的问题的看法与您自己的解决方案进行了有趣的比较，正如其他人所提到的那样应该可以正常工作！