基于列计数生成垂直汇总（Excel VBA实现需求）

实现代码 #

Sub SummarizeColumnData()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastCol As Long, lastRow As Long
    Dim colIndex As Long, targetRow As Long
    
    ' 指定源表和目标表
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet3")
    
    ' 清空目标表原有数据（保留表头行）
    wsTarget.Range("A2:B" & wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 获取源表最后一列序号，目标表起始写入行
    lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    targetRow = 2 ' 假设A1、B1为表头（如"列名"、"非空单元格数量"）
    
    ' 遍历源表所有列
    For colIndex = 1 To lastCol
        ' 获取当前列最后一行序号
        lastRow = wsSource.Cells(wsSource.Rows.Count, colIndex).End(xlUp).Row
        ' 统计当前列非空单元格数量（排除表头行）
        Dim nonEmptyCount As Long
        nonEmptyCount = Application.WorksheetFunction.CountA(wsSource.Range(wsSource.Cells(2, colIndex), wsSource.Cells(lastRow, colIndex)))
        
        ' 写入目标表对应位置
        wsTarget.Cells(targetRow, "A").Value = wsSource.Cells(1, colIndex).Value
        wsTarget.Cells(targetRow, "B").Value = nonEmptyCount
        
        targetRow = targetRow + 1
    Next colIndex
    
    ' 自动调整目标表列宽
    wsTarget.Columns("A:B").AutoFit
    
    MsgBox "汇总完成！", vbInformation
End Sub

代码说明 #

• 直接绑定源表和目标表，避免因工作表切换导致的错误
• 清空目标表历史数据，防止重复汇总内容堆积
• 用CountA函数精准统计非空单元格数量，自动过滤空值与Null
• 按列遍历后，将列名和统计结果垂直写入Sheet3
• 自动调整列宽，优化内容显示效果

使用步骤 #

1. 打开目标Excel文件，按下Alt + F11打开VBA编辑器
2. 右键点击工作簿名称，选择「插入」→「模块」
3. 将上述代码粘贴到新建模块中
4. 返回Excel界面，按下Alt + F8，选择SummarizeColumnData执行即可

内容的提问来源于stack exchange，提问作者debinsky