VBA代码调试：实现A列填充满B列空/反之则复制行到新工作表

核心问题 #

你的DataValidationTwo代码只复制第4行，主要存在三个关键错误：

1. 数组循环索引错误：数组arr从工作表第4行加载，数组索引从1开始（arr(1,1)对应AU4），但你用For i = 4 To UBound(arr)，当数据行数少于4行时循环直接跳过，即使行数足够，也只会处理数组中从第4个元素开始的部分，漏掉前面的行。
2. 未定义addToRange函数：如果没有提前定义这个自定义函数，rngCopy无法正确合并符合条件的单元格，最终只能复制最后一个被添加的行（甚至完全不生效）。
3. 范围引用偏差：原需求是A/B列，但代码里用了AU4:AV，如果不是刻意使用这两列，属于笔误。

修正后的完整代码 #

Sub DataValidationFixed()
    Dim ws As Worksheet, lastR As Long, arr, rngCopy As Range, i As Long
    Dim targetWs As Worksheet
    
    ' 设置源工作表和目标工作表
    Set ws = ActiveSheet
    Set targetWs = ThisWorkbook.Sheets("test") ' 确保test工作表存在
    
    ' 获取A列最后一行（如果要以B列为基准，改成Range("B" & ...)）
    lastR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    ' 加载A/B列数据到数组（从第4行开始，对应表头在第3行）
    arr = ws.Range("A4:B" & lastR).Value2
    
    ' 遍历数组（数组索引从1开始）
    For i = 1 To UBound(arr)
        ' 判断A/B列一填一空的条件
        If (arr(i, 1) <> "" And arr(i, 2) = "") Or (arr(i, 2) <> "" And arr(i, 1) = "") Then
            ' 合并符合条件的行到rngCopy
            If rngCopy Is Nothing Then
                Set rngCopy = ws.Rows(i + 3) ' 数组第i行对应工作表第i+3行（因为从第4行开始）
            Else
                Set rngCopy = Union(rngCopy, ws.Rows(i + 3))
            End If
        End If
    Next i
    
    ' 批量复制符合条件的行
    If Not rngCopy Is Nothing Then
        rngCopy.Copy Destination:=targetWs.Range("A" & targetWs.Rows.Count).End(xlUp).Offset(1)
    End If
    
    MsgBox "Complete"
End Sub

关键修正点说明 #

• 数组索引对应：数组arr的第i行对应工作表的i + 3行（因为数组从第4行加载，4 = 1 + 3），循环从i=1开始遍历所有数据行。
• 合并范围逻辑：去掉依赖自定义addToRange的写法，直接用Union函数合并符合条件的行，避免未定义函数的问题。
• 明确工作表引用：给目标工作表test加上ThisWorkbook限定，避免激活其他工作簿时出错；复制时指定targetWs.Rows.Count，防止引用错误的工作表行数。
• 修正列范围：把AU4:AV改回需求的A4:B，如果实际需要用AU/AV列，改回即可。

额外注意事项 #

• 确保test工作表已存在，否则会报错，可添加判断代码自动创建工作表（如果需要）。
• 如果表头不在第3行，调整i + 3中的数字：比如表头在第1行，数据从第2行开始，就改成i + 1。

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