VBA代码执行后数据集末尾出现空行填充问题求助

问题描述 #

编写了一段VBA代码用于筛选特定列、修改单元格值并高亮，但执行后数据集末尾出现大量意外填充的内容（原本无数据的行被批量修改格式和值）。

原代码 #

Sub Delivery_Time()

Dim rg As Range
Dim FilterP, Filter1, Filter6 As Variant

' For ZSFG (Syrup) need to be 'Blank'
'For ZCNC should not be blank
 Set rg = Worksheets("MARC").Range("A2").CurrentRegion

 Filter1 = Rows("1:1").Find(What:="MATERIAL TYPE", LookAt:=xlWhole).Column
 Filter6 = Rows("1:1").Find(What:="Planned Deliv. Time", LookAt:=xlWhole).Column
 FilterP = Rows("1:1").Find(What:="Procurement Type", LookAt:=xlWhole).Column

 With rg
  .AutoFilter Field:=Filter1, Criteria1:="ZSFG", Operator:=xlFilterValues
  .AutoFilter Field:=Filter6, Criteria1:="1", Operator:=xlOr, Criteria2:="2"

  With .Columns(Filter6).Offset(2).Resize(.Rows.Count - 1)
    With .SpecialCells(xlCellTypeVisible)
        .Clear
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
  End With
End With

 With rg
   .AutoFilter Field:=Filter1, Criteria1:="ZCNC", Operator:=xlFilterValues
   .AutoFilter Field:=Filter6, Criteria1:="=", Operator:=xlOr, Criteria2:="0"

    With .Columns(Filter6).Offset(2).Resize(.Rows.Count - 1)
       With .SpecialCells(xlCellTypeVisible)
          .Value = ""
          With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = RGB(255, 0, 0)
            .TintAndShade = 0
            .PatternTintAndShade = 0
          End With
      End With
  End With
 .Parent.ShowAllData

  End With

 End Sub

问题原因 #

1. 数据区域定义错误：Set rg = Worksheets("MARC").Range("A2").CurrentRegion 将数据区域起点设为A2，导致AutoFilter把工作表第2行（实际数据行）当作表头行，筛选逻辑完全错位，后续操作范围偏离目标数据。
2. AutoFilter列索引不匹配：Filter1、Filter6是工作表的绝对列号，但AutoFilter的Field参数需要的是数据区域rg内的相对列索引，直接使用绝对列号会导致筛选错误的列。
3. 操作范围错误扩大：.Offset(2).Resize(.Rows.Count - 1) 错误偏移并扩大了操作范围，超出实际数据行，导致空行被意外修改填充。

修正后的代码 #

Sub Delivery_Time()
    Dim ws As Worksheet
    Dim rg As Range
    Dim headerRow As Range
    Dim colMaterialType As Long, colPlannedDeliv As Long
    Dim relColMaterialType As Long, relColPlannedDeliv As Long
    
    Set ws = Worksheets("MARC")
    ' 定义包含表头的完整数据区域
    Set rg = ws.Range("A1").CurrentRegion
    Set headerRow = rg.Rows(1)
    
    ' 查找表头对应的工作表列号
    colMaterialType = headerRow.Find(What:="MATERIAL TYPE", LookAt:=xlWhole).Column
    colPlannedDeliv = headerRow.Find(What:="Planned Deliv. Time", LookAt:=xlWhole).Column
    
    ' 转换为数据区域内的相对列索引（AutoFilter的Field参数需要这个）
    relColMaterialType = colMaterialType - rg.Column + 1
    relColPlannedDeliv = colPlannedDeliv - rg.Column + 1
    
    ' 处理ZSFG类型数据
    rg.AutoFilter Field:=relColMaterialType, Criteria1:="ZSFG"
    rg.AutoFilter Field:=relColPlannedDeliv, Criteria1:="1", Operator:=xlOr, Criteria2:="2"
    
    ' 仅操作数据行（排除表头）的可见单元格
    On Error Resume Next ' 处理无可见单元格的情况
    rg.Columns(colPlannedDeliv).Offset(1).SpecialCells(xlCellTypeVisible).Clear
    rg.Columns(colPlannedDeliv).Offset(1).SpecialCells(xlCellTypeVisible).Interior.Color = 65535
    On Error GoTo 0
    
    ' 清除筛选
    ws.ShowAllData
    
    ' 处理ZCNC类型数据
    rg.AutoFilter Field:=relColMaterialType, Criteria1:="ZCNC"
    rg.AutoFilter Field:=relColPlannedDeliv, Criteria1:="=", Operator:=xlOr, Criteria2:="0"
    
    On Error Resume Next
    rg.Columns(colPlannedDeliv).Offset(1).SpecialCells(xlCellTypeVisible).Value = ""
    rg.Columns(colPlannedDeliv).Offset(1).SpecialCells(xlCellTypeVisible).Interior.Color = RGB(255, 0, 0)
    On Error GoTo 0
    
    ' 清除筛选
    ws.ShowAllData
End Sub

修正说明 #

• 修正数据区域为包含表头的A1.CurrentRegion，确保AutoFilter使用正确的表头行。
• 转换列号为AutoFilter所需的相对列索引，避免筛选错误列。
• 操作范围改为Offset(1)（跳过表头行），直接使用SpecialCells(xlCellTypeVisible)，避免错误扩大范围。
• 添加On Error Resume Next处理无符合条件单元格的情况，防止代码报错中断。

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