正确对齐以VBA/Excel开头的行的列

我有以不同列结尾的数据。每行的最后3列始终相同（url标记类型）

我要做的是找到列数最多的行 （在下面的示例中，bbcc.列将是G、H、I）

移动第1行和第3行的最后3列，使它们在第G、H、I行中对齐

下面的示例数据——我正在尝试将url移动到url类别下，将标记移动到标记类别下，将类型移动到类型类别下

如能为我提供帮助或指引正确的方向，将不胜感激。我不太清楚该怎么做：(

名称|颜色1 |颜色2 |颜色3 |颜色4 |颜色5 | url |标记|类型

aabb |黑色|棕色| url1 | tag1 |类型1

bbcc |绿|蓝|粉|黄|紫| url2 | tag2 |类型2

---

ccdd |橙色| url3 | tag3 |类型3

在OP澄清后编辑

在OP发生错误后编辑2

“运行时错误1004.应用程序定义的或运行时定义的错误”必须与最后一个非空单元格列索引小于3的行相关

所以我检查了一下：最后一个非空单元格列索引小于3的行将不会被处理

您可以尝试此代码（请参阅注释）

选项显式
副标题（）
变暗rng作为范围，单元格作为范围
将lastCol变暗为长，maxCol变长，iCol变长
使用工作表（“对齐”）”

看起来您导入了CSV，并且左键“将连续分隔符视为一个分隔符”处于启用状态。请返回并正确重新导入数据。感谢您的帮助。我尝试了此操作--它将整行移动到最长行的最左边一列。每行只需移动最后3个单元格。这将导致运行时错误1004。应用程序定义或运行时定义的错误“这很有效！移动单元格值是一种更好的方法。非常感谢您的帮助：）
Option Explicit

Sub main()
    Dim rng As Range, cell As Range
    Dim lastCol As Long, maxCol As Long, iCol As Long

    With Worksheets("Align") '<--| change "Align" to your actual sheet name
        Set rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants) '<--| get all columns "A" not empty cells
        ReDim lastCols(1 To rng.Count) As Long '<--| resize last column index array accordingly to the number of not empty cells

        For Each cell In rng '<--| loop through column "A" not empty cells
            iCol = iCol + 1 '<--| update last column index array index
            lastCols(iCol) = .Cells(cell.row, .Columns.Count).End(xlToLeft).Column '<--| update last column index array current index value
            If lastCols(iCol) > maxCol Then maxCol = lastCols(iCol) '<--| update maximum column index
        Next cell

        iCol = 1 '<--| initialize last column index array index
        For Each cell In rng '<--| loop through column "A" not empty cells
            If lastCols(iCol) < maxCol And lastCols(iCol) > 3 Then cell.Offset(, lastCols(iCol) - 3).Resize(, maxCol - lastCols(iCol)).Insert xlShiftToRight '<--| if current cell row has at least three not empty cells and the last one has smaller column index than maximum column index then shift current cell row last three cells to align left with maximum column index
            iCol = iCol + 1
        Next cell
    End With
End Sub

Sub main()
    Dim rng As Range, cell As Range
    Dim lastCol As Long, maxCol As Long, iCol As Long

    With Worksheets("Align") '<--| change "Align" to your actual sheet name
        Set rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants) '<--| get all columns "A" not empty cells
        ReDim lastCols(1 To rng.Count) As Long '<--| resize last column index array accordingly to the number of not empty cells

        For Each cell In rng '<--| loop through column "A" not empty cells
            iCol = iCol + 1 '<--| update last column index array index
            lastCols(iCol) = .Cells(cell.row, .Columns.Count).End(xlToLeft).Column '<--| update last column index array current index value
            If lastCols(iCol) > maxCol Then maxCol = lastCols(iCol) '<--| update maximum column index
        Next cell

        iCol = 1 '<--| initialize last column index array index
        For Each cell In rng '<--| loop through column "A" not empty cells
            If lastCols(iCol) < maxCol And lastCols(iCol) > 3 Then '<--|if current cell row has at least three not empty cells and the last one has smaller column index  than maximum column index
                With cell.Offset(, lastCols(iCol) - 3).Resize(, 3) '<--| reference current cell row last three cells
                    cell.Offset(, maxCol - 3).Resize(, 3).Value = .Value '<--|shift referenced cells values (not cells) to align left with maximum column index
                    .ClearContents '<--clear referenced cells
                End With
            End If
            iCol = iCol + 1 '<--| update last column index array index
        Next cell
    End With
End Sub

Sub AlignLast3Columns()
    Dim lColumn As Long, x As Long, y As Long, z As Long
    Dim Target As Range
    Dim Data()

    With Worksheets("After")
        x = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
        y = .Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
        Set Target = .Range("A1", .Cells(x, y))
    End With
    Data = Target.Value2
    lColumn = UBound(Data, 2)
    For x = 1 To UBound(Data, 1)
        If IsEmpty(Data(x, lColumn)) Then
            For y = lColumn To 1 Step -1
                If Not IsEmpty(Data(x, y)) Then
                    For z = 0 To 2
                        Data(x, lColumn - z) = Data(x, y - z)
                        Data(x, y - z) = ""
                    Next
                    Exit For
                End If
            Next
        End If
    Next
    Target.Value2 = Data


End Sub