Excel VBA提取J列空单元格行输出到新工作表代码修正

问题背景 #

现有工作表Table1列映射规则：

• G列：City（城市）
• H列：Department（部门）
• J列：Date（日期），存在部分空值
  需求为提取J列为空、同时符合城市、部门筛选规则的行，输出到名为output的新工作表，输出列规则：
• A列：原表行号
• B列：对应城市
• C列：对应部门

原代码存在两类核心异常：一是输出结果包含J列有日期值的行，二是输出列位置错位。

原代码问题点 #

• 输出行号计算逻辑错误：输出起始行取output表G列最后非空行，但实际输出列是A-C列，若G列无数据、A-C列残留历史错误数据，会导致行号计算错位，旧数据无法被覆盖
• 无旧数据清理逻辑：每次运行前未清空output表历史数据，之前错误运行生成的无效数据会残留在表中，被误认为本次输出结果
• 空值判断兼容性差：直接用= ""判断J列空值，无法识别单元格含不可见空格、非打印字符的场景，易出现判断失效
• 变量定义不规范：未显式定义所有变量类型，部分变量默认是Variant类型，易触发隐式类型转换错误；行号变量未用Long类型，行数超过32767时会溢出报错
• 无容错处理：若output工作表不存在会直接抛出运行时错误

修正后可直接运行代码 #

Sub missing()
    Dim ws As Worksheet, wsOut As Worksheet
    Dim lastRow As Long, lastRowOut As Long, i As Long
    Dim dateEmptyCheck As Boolean, cityCheck As Boolean, deptCheck As Boolean
    
    ' 绑定工作表，output不存在则自动创建
    Set ws = ActiveWorkbook.Sheets("Table1")
    On Error Resume Next
    Set wsOut = ActiveWorkbook.Sheets("output")
    If wsOut Is Nothing Then
        Set wsOut = ActiveWorkbook.Sheets.Add(after:=ws)
        wsOut.Name = "output"
    End If
    On Error GoTo 0
    
    ' 清空输出列历史数据，避免残留干扰
    wsOut.Range("A:C").ClearContents
    
    ' 计算行号边界
    lastRow = ws.Range("G" & ws.Rows.Count).End(xlUp).Row
    lastRowOut = wsOut.Range("A" & wsOut.Rows.Count).End(xlUp).Row + 1
    
    ' 写入表头，不需要可注释以下两行
    wsOut.Range("A1:C1") = Array("原表行号", "城市", "部门")
    lastRowOut = 2
    
    For i = 1 To lastRow
        ' 条件判断
        dateEmptyCheck = (Trim(ws.Cells(i, 10).Value) = "")
        cityCheck = (ws.Cells(i, 7).Value = "Peking" Or _
                    ws.Cells(i, 7).Value = "Tokio" Or _
                    ws.Cells(i, 7).Value = "London" Or _
                    ws.Cells(i, 7).Value = "Rom" Or _
                    ws.Cells(i, 7).Value = "Lissabon" Or _
                    ws.Cells(i, 7).Value = "Panama" Or _
                    ws.Cells(i, 7).Value = "Budapest" Or _
                    ws.Cells(i, 7).Value = "Prag" Or _
                    ws.Cells(i, 7).Value = "Dublin" Or _
                    ws.Cells(i, 7).Value = "Luxemburg")
        deptCheck = (ws.Cells(i, 8).Value >= "A" And ws.Cells(i, 8).Value <= "J")
        
        ' 符合条件则按要求写入
        If dateEmptyCheck And cityCheck And deptCheck Then
            wsOut.Cells(lastRowOut, 1).Value = i
            wsOut.Cells(lastRowOut, 2).Value = ws.Cells(i, 7).Value
            wsOut.Cells(lastRowOut, 3).Value = ws.Cells(i, 8).Value
            lastRowOut = lastRowOut + 1
        End If
    Next i
End Sub

修正说明 #

• 补全所有变量的显式类型定义，行号统一用Long类型避免溢出
• 增加工作表自动创建逻辑，output表不存在时会自动生成，不会报错
• 每次运行前清空output表A-C列所有旧数据，彻底避免历史残留数据干扰
• 修正输出起始行计算逻辑，从输出表A列而非G列取最后非空行，行号计算准确
• 优化空值判断逻辑，增加Trim()函数处理，可识别含不可见空格的空单元格，判断准确率更高
• 简化部门区间判断逻辑，替换冗余的多条件Or判断，代码更简洁
• 调整写入逻辑，逐列按A（原行号）、B（城市）、C（部门）的顺序写入，彻底解决列错位问题
• 可选增加表头行，不需要直接注释对应代码即可

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