Excel VBA循环处理列数据 移动SOUTH与NORTH/EAST/WEST间的内容

• rng对象未初始化就调用rng.Rows.Count，循环上限未定义，运行直接报错
• Do Until的条件语法错误，VBA不支持值 = A Or B Or C的写法，必须每个值单独做相等判断，原逻辑完全不生效
• Do循环缺少对应的Loop闭合语句，语法结构不完整
• Find方法未限定搜索列，会遍历整个工作表，且未处理找不到SOUTH的场景，rngFound为Nothing时调用Offset会抛出空对象错误
• 仅处理SOUTH下方的第一个单元格，没有循环处理SOUTH到下一个方向标（NORTH/EAST/WEST）之间的所有行
• 重复搜索逻辑有问题，未跳过已处理区域，可能出现循环搜索同一个SOUTH的问题

Sub MoveSouthBelowContent()
    Const PROCESS_COLUMN As String = "A" ' 这里改成你要处理的列
    Const MOVE_OFFSET As Integer = 1 ' 向右移动1列，要多移可以改
    Dim lastRow As Long
    Dim i As Long
    Dim inSouthRange As Boolean
    
    ' 获取目标列最后一行有数据的行号
    lastRow = Cells(Rows.Count, PROCESS_COLUMN).End(xlUp).Row
    inSouthRange = False
    
    For i = 1 To lastRow
        With Cells(i, PROCESS_COLUMN)
            ' 遇到SOUTH，标记接下来要处理的区间
            If InStr(1, .Value, "SOUTH", vbTextCompare) > 0 Then
                inSouthRange = True
            ' 遇到三个方向标，结束当前处理区间
            ElseIf .Value = "NORTH" Or .Value = "WEST" Or .Value = "EAST" Then
                inSouthRange = False
            ' 处于SOUTH和方向标之间的内容，移动到右侧
            ElseIf inSouthRange And .Value <> "" Then
                .Cut Destination:=.Offset(0, MOVE_OFFSET)
            End If
        End With
    Next i
End Sub

• 如果你需要精确匹配单元格值完全等于SOUTH，把判断SOUTH的那一行改成If .Value = "SOUTH" Then即可
• 代码默认处理A列，向右移动1列，你可以修改开头两个常量的参数适配自己的表格
• 遍历全列自动识别所有SOUTH到对应方向标之间的区间，批量移动所有符合要求的内容，无需手动指定搜索范围
• 加入了空值判断，空白单元格不会做移动处理

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