VBA删除多个工作表中有标题而没有数值的空白列

wpeidong

请见附件：在sheet2到sheet5中，有的列有标题而没有数值，怎样通过VBA一次删除这些列。我参考了好多方法，都没有成功，请专家帮忙！谢谢您！

wpeidong

有网页和文件excelhome.net
搜索工具百度为您找到相关结果约402个
批量删除多个工作表中的空列(整列)-ExcelVBA程序开发-Exce... （这个文章不能解决我的问题，在这个例子的最后一个工作表中，如果在7月的A1中输入1，会把9月有数值的一列删掉）

wpeidong

批量删除多个工作表中的空列(整列)-ExcelVBA程序开发-Exce...（这个文件不能解决我的问题）

wpeidong

找遍全网，没有一个方法能够一次解决这个问题，现有一个办法可以间接解决，就是先删除每个工作表的表头，然后用Python代码删除空白列（网上有针对这个问题的python视频）

音韵神奇

请看以下代码

音韵神奇

摘抄于（https://zh-cn.extendoffice.com/d ... ns-with-header.html）
Sub Macro1()
'updateby Extendoffice
    Dim xEndCol As Long
    Dim I As Long
    Dim xDel As Boolean
    On Error Resume Next
    xEndCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    If xEndCol = 0 Then
        MsgBox "There is no data on """ & ActiveSheet.Name & """ .", vbExclamation, "Kutools for Excel"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    For I = xEndCol To 1 Step -1
        If Application.WorksheetFunction.CountA(Columns(I)) <= 1 Then
            Columns(I).Delete
            xDel = True
        End If
    Next
    If xDel Then
        MsgBox "All blank and column(s) with only a header row have now been deleted.", vbInformation, "Kutools for Excel"
    Else
        MsgBox "There are no Columns to delete as each one has more data (rows) than just a header.", vbExclamation, "Kutools for Excel"
    End If
    Application.ScreenUpdating = True
End Sub