Question

对以下压缩并重新格式化列表的代码有一些疑问。

我将变量endIndicator设置为列表结尾的临时标记。通过我的ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row - 1不断检查列表的当前结尾会更好吗？
我在删除循环中尝试了With ActiveCell.Offset(rowOffset)语句，这给了我

运行时错误424需要对象

在循环的第二次迭代中。我认为这与上一行的破坏有关。是否有适当的With语句可用于此循环？
类似地，我为最后三个语句尝试了With ActiveCell.EntireColumn，并得到了相同的结果。我假设出于同样的原因。有合适的解决方案吗？

这是代码

Option Explicit

Sub Condense1()    
'Purpose : Condense list by removing unwanted rows    
'Requires: Column B row verbiage    
'          Column A row blank for unwanted row    
'Returns : Single compressed column of values wanted    

    Dim endIndicator As String
    Dim rowOffset As Long

    Worksheets(1).Activate          'Select Sheet
    Range("A1").Select              'Set offset base

    endIndicator = "zzzendozx"      'Assign unique value unlikely to be duplicated
                                    'Find last used row
    rowOffset = ActiveSheet.UsedRange.Rows.Count _
        + ActiveSheet.UsedRange.Rows(1).Row - 1
                                    'Temporarily mark next row as loop terminator
    ActiveCell.Offset(rowOffset, 0).Value = endIndicator

    rowOffset = 0                   'Reset offset pointer

                                    'For each row from top to loop terminator
    Do While ActiveCell.Offset(rowOffset).Value <> endIndicator
                                    ' Delete rows whose column "A" is empty
        If Len(ActiveCell.Offset(rowOffset).Value) < 1 Then
            ActiveCell.Offset(rowOffset).EntireRow.Delete
        Else
            rowOffset = rowOffset + 1   'Otherwise prepare to look at next row
        End If
    Loop
    ActiveCell.Offset(rowOffset).EntireRow.Delete   'Remove loop terminator row
    ActiveCell.EntireColumn.Delete                  'Remove Column A
    ActiveCell.EntireColumn.Font.Size = 14          'Set Font
    ActiveCell.EntireColumn.AutoFit                 'Set optimum column width

End Sub

Answer 1

这可能会有所帮助：

Sub Kompressor()
    Dim nLastRow As Long, nFirstRow As Long, i As Long
    Set r = ActiveSheet.UsedRange

    nLastRow = r.Rows.Count + r.Row - 1
    nFirstRow = r.Row

    For i = nLastRow To nFirstRow Step -1
        With Cells(i, 1)
            If .Value = "" Then .EntireRow.Delete
        End With
    Next i
End Sub

请注意，我们向后循环执行向后。
如果仅删除一次，则代码的运行速度会稍快。

更好的VBA压缩列表方式

1 个答案: