Excel VBA循环中查找下一个空行索引的实现问题

你的核心需求是定位!JOURNAL行对应的下一个空行，以此确定当前数据段的结束位置，再执行剪切粘贴操作。之前的尝试主要问题是嵌套循环逻辑错误，以及CurrentRegion用法不当，以下是修正后的实现方案：

修正后的完整VBA代码 #

Dim x As Long
Dim lastrow As Long
Dim idxblankrow As Long

lastrow = Cells(Rows.Count, "A").End(xlUp).Row

' 遍历工作表行，用Long避免行号超出Integer范围
For x = 1 To lastrow
    ' 匹配目标行：A列前8位为!JOURNAL且H列非空
    If Left(CStr(Cells(x, "A").Value), 8) = "!JOURNAL" And Not IsEmpty(Cells(x, "H")) Then
        ' 从当前行下一行开始查找第一个A列为空的行
        idxblankrow = x + 1
        Do While idxblankrow <= lastrow And Not IsEmpty(Cells(idxblankrow, "A"))
            idxblankrow = idxblankrow + 1
        Loop
        
        ' 处理找到空行的情况
        If idxblankrow <= lastrow Then
            ' 剪切A-H列到B-I列
            Range(Cells(x + 2, "A"), Cells(idxblankrow - 1, "H")).Cut _
                Destination:=Range(Cells(x + 2, "B"), Cells(idxblankrow - 1, "I"))
            
            ' 复制当前行H列值到目标A列区域
            Cells(x, "H").Copy
            Range(Cells(x + 2, "A"), Cells(idxblankrow - 1, "A")).PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Else
            ' 处理数据段到工作表末尾无空行的情况
            Range(Cells(x + 2, "A"), Cells(lastrow, "H")).Cut _
                Destination:=Range(Cells(x + 2, "B"), Cells(lastrow, "I"))
            
            Cells(x, "H").Copy
            Range(Cells(x + 2, "A"), Cells(lastrow, "A")).PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
        
        Application.CutCopyMode = False
    End If
Next x

关键修正说明 #

• 替换Integer为Long：Excel行号可能超过Integer最大值（32767），Long类型适配更大范围的行号。
• 用Do While精准查找空行：从当前行下一行开始逐行检查A列，直到找到空行或到达工作表末尾，避免嵌套循环的逻辑混乱。
• 增加边界判断：处理数据段延伸到工作表末尾无空行的场景，防止代码报错。
• 移除冗余Select操作：直接操作Range对象比依赖Select更高效，也减少运行时出错概率。
• 新增CStr转换：避免单元格值为数字时Left函数抛出类型错误。

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