VBA:隐藏空列 (=0)

VBA: Hiding Columns That Are Empty (=0)

我创建了一个宏(有效),遍历我知道我正在使用的所有列,检查这些列的总和是否等于零,如果它们等于零,则该宏将单独隐藏列(请参阅下面我当前的宏)。

但是,可以相当定期地添加新列,所以我希望有人可以帮助创建一个遍历所有使用的列的循环,而不是必须将每个使用的列设置为宏中的变量。

Sub RemoveEmptyColumns()

    Application.ScreenUpdating = False

    Dim column1 As Double, column2 As Double, column3 As Double
    Dim column4 As Double, column5 As Double, column6 As Double
    Dim column7 As Double, column8 As Double, column9 As Double
    Dim column10 As Double, column11 As Double, column12 As Double
    Dim column13 As Double, column14 As Double, column15 As Double
    Dim column16 As Double, column17 As Double, column18 As Double
    Dim column19 As Double, column20 As Double, column21 As Double
    Dim column22 As Double, column23 As Double, column24 As Double
    Dim column25 As Double, column26 As Double, column27 As Double
    Dim column28 As Double, column29 As Double, column30 As Double
    Dim column31 As Double, column32 As Double, column33 As Double
    Dim column34 As Double, column35 As Double, column36 As Double
    Dim column37 As Double
    
    column1 = Application.WorksheetFunction.Sum(Range("D4:D708"))
    column2 = Application.WorksheetFunction.Sum(Range("E4:E708"))
    column3 = Application.WorksheetFunction.Sum(Range("F4:F708"))
    column4 = Application.WorksheetFunction.Sum(Range("G4:G708"))
    column5 = Application.WorksheetFunction.Sum(Range("H4:H708"))
    column6 = Application.WorksheetFunction.Sum(Range("I4:I708"))
    column7 = Application.WorksheetFunction.Sum(Range("J4:J708"))
    column8 = Application.WorksheetFunction.Sum(Range("K4:K708"))
    column9 = Application.WorksheetFunction.Sum(Range("L4:L708"))
    column10 = Application.WorksheetFunction.Sum(Range("M4:M708"))
    column11 = Application.WorksheetFunction.Sum(Range("N4:N708"))
    column12 = Application.WorksheetFunction.Sum(Range("O4:O708"))
    column13 = Application.WorksheetFunction.Sum(Range("P4:P708"))
    column14 = Application.WorksheetFunction.Sum(Range("Q4:Q708"))
    column15 = Application.WorksheetFunction.Sum(Range("R4:R708"))
    column16 = Application.WorksheetFunction.Sum(Range("S4:S708"))
    column17 = Application.WorksheetFunction.Sum(Range("T4:T708"))
    column18 = Application.WorksheetFunction.Sum(Range("U4:U708"))
    column19 = Application.WorksheetFunction.Sum(Range("V4:V708"))
    column20 = Application.WorksheetFunction.Sum(Range("W4:W708"))
    column21 = Application.WorksheetFunction.Sum(Range("X4:X708"))
    column22 = Application.WorksheetFunction.Sum(Range("Y4:Y708"))
    column23 = Application.WorksheetFunction.Sum(Range("Z4:Z708"))
    column24 = Application.WorksheetFunction.Sum(Range("AA4:AA708"))
    column25 = Application.WorksheetFunction.Sum(Range("AB4:AB708"))
    column26 = Application.WorksheetFunction.Sum(Range("AC4:AC708"))
    column27 = Application.WorksheetFunction.Sum(Range("AD4:AD708"))
    column28 = Application.WorksheetFunction.Sum(Range("AE4:AE708"))
    column29 = Application.WorksheetFunction.Sum(Range("AF4:AF708"))
    column30 = Application.WorksheetFunction.Sum(Range("AG4:AG708"))
    column31 = Application.WorksheetFunction.Sum(Range("AH4:AH708"))
    column32 = Application.WorksheetFunction.Sum(Range("AI4:AI708"))
    column33 = Application.WorksheetFunction.Sum(Range("AJ4:AJ708"))
    column34 = Application.WorksheetFunction.Sum(Range("AK4:AK708"))
    column35 = Application.WorksheetFunction.Sum(Range("AL4:AL708"))
    column36 = Application.WorksheetFunction.Sum(Range("AM4:AM708"))
    column37 = Application.WorksheetFunction.Sum(Range("AN4:AN708"))
 
    If column1 = 0 Then
    Columns("D:D").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column2 = 0 Then
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column3 = 0 Then
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column4 = 0 Then
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column5 = 0 Then
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column6 = 0 Then
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column7 = 0 Then
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column8 = 0 Then
    Columns("K:K").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column9 = 0 Then
    Columns("L:L").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column10 = 0 Then
    Columns("M:M").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column11 = 0 Then
    Columns("N:N").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column12 = 0 Then
    Columns("O:O").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column13 = 0 Then
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column14 = 0 Then
    Columns("Q:Q").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column15 = 0 Then
    Columns("R:R").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column16 = 0 Then
    Columns("S:S").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column17 = 0 Then
    Columns("T:T").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column18 = 0 Then
    Columns("U:U").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column19 = 0 Then
    Columns("V:V").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column20 = 0 Then
    Columns("W:W").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column21 = 0 Then
    Columns("X:X").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column22 = 0 Then
    Columns("Y:Y").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column23 = 0 Then
    Columns("Z:Z").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column24 = 0 Then
    Columns("AA:AA").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column25 = 0 Then
    Columns("AB:AB").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column26 = 0 Then
    Columns("AC:AC").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column27 = 0 Then
    Columns("AD:AD").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column28 = 0 Then
    Columns("AE:AE").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column29 = 0 Then
    Columns("AF:AF").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column30 = 0 Then
    Columns("AG:AG").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column31 = 0 Then
    Columns("AH:AH").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column32 = 0 Then
    Columns("AI:AI").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column33 = 0 Then
    Columns("AJ:AJ").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column34 = 0 Then
    Columns("AK:AK").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column35 = 0 Then
    Columns("AL:AL").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column36 = 0 Then
    Columns("AM:AM").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    If column37 = 0 Then
    Columns("AN:AN").Select
    Selection.EntireColumn.Hidden = True
    End If
    
    Application.ScreenUpdating = True
    
End Sub

如有任何帮助,我们将不胜感激。

谢谢!

您可以通过循环缩短代码。

如果最后一行可能会发生变化,则您也不需要对其进行硬编码。

no need to select.

Sub x()

Dim n As Long, c As Long

n = Cells(4, Columns.Count).End(xlToLeft).Column 'find last column in row 4

For c = 1 To n 'loop through each column
    If Application.WorksheetFunction.Sum(Range(Cells(4, c), Cells(708, c))) = 0 Then
        Cells(4, c).EntireColumn.Hidden = True
    End If
Next c

End Sub