Question

美好的一天，

我正在尝试创建一个宏，根据条件将行移动到工作表的底部。到目前为止我能够做到的就是将行复制到底部，但这会为我创建一个重复的行，实际上我只需要移动它。

'Moving column "Grand Total" to bottom

With Wbk4.Sheets("TEST")
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    'Loop through each row
    For x = 2 To FinalRow
        'Decide if to copy based on column A
        ThisValue = Cells(x, 1).Value
        If ThisValue = "Grand Total" Then
            Cells(x, 1).Resize(1, 33).Copy
            lrow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & lrow + 1, "Z" & lrow + 1).PasteSpecial xlPasteAll
        End If
    Next x
End With

由于

Answer 1

在Cells(x, 1).EntireRow.Delete

之前尝试Cells(x, 1).Resize(1, 33).Delete或End If

Answer 2

由于您没有提供样本数据，因此很难推荐自定义排序，但右侧的临时帮助列可以快速将所有 Grand Total 行移至底部。< / p>

With Wbk4.Sheets("TEST")
    With .Cells(1, 1).CurrentRegion
        .Columns(.Columns.Count).Offset(1, 1).Resize(.Rows.Count - 1, 1).Formula = "=--(A2=""Grand Total"")"
    End With
    With .Cells(1, 1).CurrentRegion  'reestablish current region with new helper column
        .Cells.Sort Key1:=.Columns(.Columns.Count), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes
        .Columns(.Columns.Count).Cells.ClearContents
    End With
End With

如果您想添加其他排序顺序，还有两个额外的排序键（最多三个没有加倍）。

Answer 3

谢谢Jeeped，它工作得很好!! 我在尝试你的代码之前使用了另一种方法，它也有效！我在下面发布它以供参考，以防有人在将来寻找代码参考

'Moving column B to bottom
With Wbk4.Sheets("test")
    FinalRow = .Cells(rows.Count, 1).End(xlUp).Row
    'Loop through each row
    For x = 2 To FinalRow
        'Decide if to copy based on column A
        ThisValue = .Cells(x, 1).Value
        If ThisValue = "Grand Total" Then
            .Cells(x, 1).Resize(1, 33).Select
            Selection.Cut
            lRow = .Range("A" & .rows.Count).End(xlUp).Row
            .Range("A" & lRow + 1, "Z" & lRow + 1).Select
            ActiveSheet.Paste
        End If
    Next x
End With

'Delete Blank Rows 
Dim i As Long
With Wbk4.Sheets("test")
    For i = .Range("A" & rows.Count).End(xlUp).Row To 1 Step -1
        If .Range("A" & i) = "" Then
            .Range("A" & i).EntireRow.Delete
        End If
    Next i
End With

Excel宏将行移动到底部

3 个答案: