与 VBA excel 交换行

Question

我想根据条件交换特定行。我的工作簿包含多行对集：

第 1 行：

第 2 行：条目 1；值 1

第 3 行：条目 2；值 2

第 4 行：

第 5 行：条目 3；值 3

第 6 行：条目 4；值 4

第 7 行： ...

如果某个条件为真，我想交换一对条目中的行。例如，如果值 2 大于值 1（第一对条目），则交换第 2 行和第 3 行。继续下一对。如果值 4 大于值 3（第二对条目），则交换第 5 行和第 6 行。如果值 4 不大于值 3，则保持原样。我已经想出如何手动交换两行，但由于我有一个包含多对行的大列表，我想自动化该过程。非常感谢任何帮助。提前致谢。

Answer 1

如果第二个值大于第一个值

，希望下面的代码有助于比较 swap/move 列

下面是excelsheet

的图片

在运行代码之前

在运行代码之后

代码：

Public Working_Sheet As Worksheet
Public FirstRow As Integer
Public LastRow As Integer
Public Comp_No1, Comp_No2


Sub Button1_Click()
'Setting the worksheet where data avaliable
Set Working_Sheet = Worksheets("Sheet1")

'Marking the first row number
FirstRow = 1

'Marking the last row number
LastRow = Working_Sheet.Cells(Rows.Count, "A").End(xlUp).Row
'MsgBox (LastRow)


'Looping throught all the rows
For i = 2 To LastRow


'Ass the first compare row and the +1 for second compare
Comp_No1 = i
Comp_No2 = i + 1

'Checking the Column A with the number to make sure its not empty
If Working_Sheet.Range("A" & i).Value <> "" Then

'MsgBox (Working_Sheet.Range("B" & Comp_No1).Value)
'MsgBox (Working_Sheet.Range("B" & Comp_No2).Value)

'Checking if the B value of Second entry is less than B Value of the is Entry
If Working_Sheet.Range("B" & Comp_No1).Value < Working_Sheet.Range("B" & Comp_No2).Value Then
'Cutting 2nd row
Rows(i + 1).Cut
'Moving or inserting the cutted row to pervious row
Rows(i).Insert
End If


End If

'inc the I value +2 for next row
i = i + 2


Next

End Sub

与 VBA excel 交换行

Swapping rows with VBA excel

excel

vba

rows

swap