VBA循环剪切追加代码异常求助：列数据处理问题排查

我来帮你排查下现有代码的问题，然后给出调整后的方案。首先明确你的需求：把F列文本分列后得到的I列里的非空单元格，剪切并追加到原B列数据的末尾对吧？

现有代码的核心问题 #

• 列索引搞错了：你要处理的是I列（对应第9列），但代码里判断的是Cells(OstatniWiersz, 10)也就是J列，这直接导致你没选中目标单元格。
• 缺少粘贴操作：代码只执行了Cut但没有后续的粘贴动作，剪切的内容没地方放置，等于白操作。
• 目标行固定值不合理：用OstatniWiersz + 1000作为目标行，不仅可能覆盖原有数据，还没办法动态追加到B列的最新末尾。

改进后的完整代码 #

下面是调整后的代码，我加了注释说明每一步的作用：

Sub MoveNonEmptyCells()
    Dim lastRowOfData As Long
    Dim currentRow As Long
    Dim lastRowOfB As Long
    
    ' 获取整个数据区域的最后一行（包含所有列）
    lastRowOfData = Cells.Find(What:="*", _
        After:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
    
    ' 从下往上遍历，避免剪切行导致的行号错乱
    For currentRow = lastRowOfData To 1 Step -1
        ' 判断I列（第9列）当前单元格是否非空（排除仅含空格的情况）
        If Not IsEmpty(Cells(currentRow, 9)) And Trim(Cells(currentRow, 9).Value) <> "" Then
            ' 动态获取B列当前的最后一行，每次追加到新末尾
            lastRowOfB = Cells(Rows.Count, 2).End(xlUp).Row + 1
            
            ' 剪切并直接粘贴到目标位置
            Cells(currentRow, 9).Cut Destination:=Cells(lastRowOfB, 2)
        End If
    Next currentRow
End Sub

额外优化说明 #

1. 用Long代替Integer：Excel的行数可能超过Integer的最大值（32767），用Long能避免溢出问题。
2. 双重非空判断：IsEmpty加Trim是为了排除那些看起来是空但实际包含空格的单元格。
3. 动态更新B列末尾：每次循环都重新获取B列的最后一行，确保每次都追加到最新的位置，不会出现错位或覆盖。

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