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

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

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 - 循环而不是循环遍历数组，如果我读{{3是正确的，除非输入范围非常大，否则它并不重要。

如你所见，它显着缩短了，并且我发现它更容易阅读 - 虽然可能只是熟悉这种语法而不是你的语法。不幸的是，我不在我的工作计算机上。测试它，但我认为它应该做你想要的。

如果您的主要目标是提高代码的性能，我认为在代码运行时查看可能关闭的设置将比您使用的循环和变量分配更具效果。我发现this answer是对VBA编码时要记住的一些概念的一个很好的介绍。

我希望你发现我对你的问题的看法与你自己的解决方案有一个有趣的比较，正如其他人提到的那样应该工作得很好！

Answer 2

如果我理解你想要删除空格并拉出任何给定行上的数据？

我会通过将数组转换为与管道连接的字符串来实现它，清除任何双管道（循环直到没有剩余的双打）然后将其推回到整个行的数组：

这是我的代码：

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

我为你准备了一个子测试。

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

VBA Sub从行改进中删除空白

2 个答案: