将非空行复制/剪切至顶部行的VBA代码优化需求

原代码存在两个明确缺陷：

• 仅校验每行A列是否为空，完全忽略B、C列的非空值，导致B/C列有内容但A列为空的行无法被识别处理。
• 当A4本身有值时，源区域会包含A4:C4，剪切操作因区域重叠报错，且无法正确覆盖A4原有值。

修复后的代码 #

Sub CopyNonEmptyRowsToTopRowsFixed()
    Dim rng As Range
    Dim i As Integer
    Dim targetStart As Range
    
    Set targetStart = Sheet4.Range("A4")
    
    ' 遍历A4-A7行，检查整行A-C是否有非空值
    For i = 4 To 7
        If WorksheetFunction.CountA(Sheet4.Range("A" & i & ":C" & i)) > 0 Then
            If rng Is Nothing Then
                Set rng = Sheet4.Range("A" & i & ":C" & i)
            Else
                Set rng = Union(rng, Sheet4.Range("A" & i & ":C" & i))
            End If
        End If
    Next i
    
    ' 处理非空区域的移动，避免重叠报错
    If Not rng Is Nothing Then
        If Not Intersect(rng, targetStart.Resize(rng.Rows.Count, 3)) Is Nothing Then
            ' 源区域包含目标起始行，先临时存到表格底部
            Dim tempRng As Range
            Set tempRng = Sheet4.Cells(Sheet4.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, 3)
            rng.Copy tempRng
            rng.ClearContents
            tempRng.Cut targetStart
        Else
            rng.Cut targetStart
        End If
    End If
End Sub

关键修复说明 #

1. 完整的非空校验：
   用CountA函数判断每行A-C列的非空单元格数量，只要大于0就认定该行需要处理，不再局限于A列的内容。

2. 解决区域重叠问题：
   新增判断逻辑，当源区域包含A4（目标起始行）时，先把内容临时复制到表格最后一行的下一行，清空原行后再剪切到A4，彻底避免剪切操作因区域重叠导致的报错，同时确保A4原有值被完全覆盖。

3. 避免空操作报错：
   增加If Not rng Is Nothing的判断，当A4:C7全为空时，不会执行任何剪切/复制操作，防止运行时错误。

如果需要保留原行内容（用复制替代剪切），只需将代码中的Cut替换为Copy，并删除rng.ClearContents这一行即可。

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