vba - 循环遍历每一列并删除具有 "0"的列

Question

我没有收到任何错误，但它没有删除带有“0”的列。我只想删除包含大量 0 的列，正如您可以从我的代码中读取的那样。我不确定可能出了什么问题，因此欢迎提出任何建议。

Sub Finalize()
Dim finalform As Worksheet
Dim deletename As String
Dim finalworkbook As Workbook
Dim ws As Worksheet
Dim copyrange As Range
Dim columnloop As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set finalform = Workbooks(ActiveWorkbook.Name).ActiveSheet

For a = 3 To 18

If Range("B" & a).Value <> "" Then
    Workbooks.Open finalform.Range("B" & a).Value
    Set finalworkbook = Workbooks(ActiveWorkbook.Name)

        'Delete sheets
        For b = 3 To 12
        deletename = finalform.Range("D" & b).Value
        If deletename <> "" Then
        finalworkbook.Worksheets(deletename).Delete
        End If
        Next b

        'Find, replace, remove
        For Each ws In ActiveWorkbook.Worksheets

            'Copy paste values
            Set copyrange = ws.Cells
            copyrange.Copy
            copyrange.PasteSpecial xlPasteValues
            Application.CutCopyMode = False

            'Delete columns with 0
            For Each columnloop In copyrange.Columns
            d = 0
                For c = 1 To 35
                If Cells(c, columnloop.Column).Value = "0" Then
                d = d + 1
                End If
                Next c
            If d > 5 Then
            columnloop.Delete
            End If
            Next columnloop

        Next ws
End If
Next a

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

您的循环可以替换为更有效的计数方法。删除行或列时，您应该始终从范围开始，并朝着 A1 方向努力，以便在下一次增量期间不会跳过列。

Dim c As Long, ws As Worksheet

'Find, replace, remove
For Each ws In ActiveWorkbook.Worksheets
    With ws
        .UsedRange.Cells = .UsedRange.Cells.Value
       'Delete columns with 0
        For c = .UsedRange.Columns.Count To 1 Step -1
            If Application.CountIf(.Columns(c), 0) > 5 Then
                .Columns(c).EntireColumn.Delete
            End If
        Next c

    End With
Next ws

还有其他几个方面可以调整。一旦达到操作标准，请考虑将其发布到 Code Review (Excel)进一步改进。