vba Excel宏将一行移到底部
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/26953967/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel macro to move a row to bottom
提问by Nadz
Good day,
再会，
I am trying to create a macro that moves a row to the bottom of the sheet based on criteria. What i have been able to do so far is copy the row to the bottom, but this will create a duplicate row for me, where in reality i only need it to be moved.
我正在尝试创建一个宏，根据条件将一行移动到工作表的底部。到目前为止我能够做的是将行复制到底部，但这将为我创建一个重复的行，实际上我只需要移动它。
'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
Thanks
谢谢
采纳答案by ZAT
As you've provided no sample data, it is hard to recommend a custom sort but a temporary helper column off the right side could quickly move all Grand Totalrows to the bottom.
由于您未提供示例数据，因此很难推荐自定义排序，但右侧的临时辅助列可以快速将所有总计行移至底部。
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
There are two additional sort keys (maximum of three without doubling up) if you wanted to add additional sorting order(s).
如果您想添加额外的排序顺序，还有两个额外的排序键（最多三个而不加倍）。
回答by ZAT
Try Cells(x, 1).EntireRow.Deleteor Cells(x, 1).Resize(1, 33).Deletebefore End If
尝试Cells(x, 1).EntireRow.Delete或Cells(x, 1).Resize(1, 33).Delete之前End If
回答by Nadz
Thanks Jeeped, it works fine !! I Did it using another method before trying your code, and it works too!! I am posting it below for reference in case anyone is looking for code references in the future
谢谢吉普德，它工作正常！！我在尝试您的代码之前使用另一种方法做了它，它也有效！！我将其发布在下面以供参考，以防将来有人在寻找代码参考
'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
