使用CountIfs：

Sub delete()
   Dim FinalCol As Long
   FinalCol = Cells(1, Columns.Count).End(xlToLeft).Column

   Dim i As Long
   For i = FinalCol To 1 Step -1
       If WorksheetFunction.CountIfs(Columns(i), "<>0", Columns(i), "<>") = 0 Then
          Columns(i).delete
       End If
   Next i
End Sub

最好使用Union并在循环后删除，而不是在循环内删除：

Sub delete()
   Dim FinalCol As Long
   FinalCol = Cells(1, Columns.Count).End(xlToLeft).Column

   Dim i As Long
   For i = 1 to FinalCol
       If WorksheetFunction.CountIfs(Columns(i), "<>0", Columns(i), "<>") = 0 Then
          Dim ToDelete As Range
          If ToDelete Is Nothing Then
              Set ToDelete = Columns(i)
          Else
              Set ToDelete = Union(ToDelete, Columns(i))
          End If
      End If
   Next

   If Not ToDelete Is Nothing Then 
       ToDelete.Delete
   End If
End Sub

另一个选择是使用CountIfs和CountA：

If WorksheetFunction.CountIf(Columns(i), 0) = WorksheetFunction.CountA(Columns(i)) Then

这两个选项的逻辑是：
1.如果列不包含任何非零元素，则删除该列。
1.如果零的计数=列中非空元素的计数，则删除该列。

所有只包含数字零的单元格

• 如果区域中某列的所有单元格都只包含数字0或计算结果为数字0的公式，则将删除整个（工作表）列。

Sub DeleteColumns()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    
    Dim srg As Range, Data() As Variant, rCount As Long
    
    With ws.UsedRange
        rCount = .Rows.Count - 1 ' use -1 to exclude headers
        Set srg = .EntireColumn
        Data = .Resize(rCount).Offset(1)
    End With
    
    Dim urg As Range, crg As Range, r As Long, c As Long, ZeroFound As Boolean
    
    For c = 1 To UBound(Data, 2)
        For r = 1 To rCount
            ' Blank cells or cells containing '="0"' are not considered!
            If VarType(Data(r, c)) = vbDouble Then ' is a number
                If Data(r, c) = 0 Then ZeroFound = True
            End If
            If ZeroFound Then ZeroFound = False Else Exit For
        Next r
        If r > rCount Then
            Set crg = srg.Columns(c)
            If urg Is Nothing Then Set urg = crg Else Set urg = Union(urg, crg)
        End If
    Next c
            
    If Not urg Is Nothing Then urg.Delete
        
End Sub