循環遍歷每列並刪​​除「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)以進一步改進。