0

Excel VBA參照上方列最近的數字，決定是否要執行

Sub CopyRows()
Dim X As Integer
Dim Cnt As Integer
Cnt = 2

``````For X = DCLocRow + 1 To TotalRow  'Loop through each row
LVValue = Cells(X, 2).Value 'Decide if to copy based on column B
If LVValue = "3" Then
Sheets("Result").Cells(Cnt, 2).Value = Sheets("Sheet1").Cells(X, 3).Value
Sheets("Result").Cells(Cnt, 4).Value = Sheets("Sheet1").Cells(X, 2).Value
Sheets("Result").Cells(Cnt, 3).Value = Sheets("Sheet1").Cells(X, 7).Value
Sheets("Result").Cells(Cnt, 1).Value = Sheets("Sheet1").Cells(X, 1).Value
Cnt = Cnt + 1

ElseIf LVValue = "A" Then
Sheets("Result").Cells(Cnt, 2).Value = Sheets("Sheet1").Cells(X, 3).Value
Sheets("Result").Cells(Cnt, 4).Value = Sheets("Sheet1").Cells(X, 2).Value
Sheets("Result").Cells(Cnt, 3).Value = Sheets("Sheet1").Cells(X, 7).Value
Sheets("Result").Cells(Cnt, 1).Value = Sheets("Sheet1").Cells(X, 1).Value
Cnt = Cnt + 1

ElseIf LVValue = "2" Then
Exit For
End If
Next X
``````

End Sub

1 個回答

0

iT邦大神 1 級 ‧ 2020-06-29 09:01:42

``````Sub CopyRows()
Dim X As Integer
Dim Cnt As Integer
Dim CopyValue As Boolean
Cnt = 2

For X = DCLocRow + 1 To TotalRow  'Loop through each row
LVValue = Cells(X, 2).Value 'Decide if to copy based on column B
If LVValue = "3" Then
Sheets("Result").Cells(Cnt, 2).Value = Sheets("Sheet1").Cells(X, 3).Value
Sheets("Result").Cells(Cnt, 4).Value = Sheets("Sheet1").Cells(X, 2).Value
Sheets("Result").Cells(Cnt, 3).Value = Sheets("Sheet1").Cells(X, 7).Value
Sheets("Result").Cells(Cnt, 1).Value = Sheets("Sheet1").Cells(X, 1).Value
Cnt = Cnt + 1

ElseIf LVValue = "A" Then
If CopyValue = True Then
Sheets("Result").Cells(Cnt, 2).Value = Sheets("Sheet1").Cells(X, 3).Value
Sheets("Result").Cells(Cnt, 4).Value = Sheets("Sheet1").Cells(X, 2).Value
Sheets("Result").Cells(Cnt, 3).Value = Sheets("Sheet1").Cells(X, 7).Value
Sheets("Result").Cells(Cnt, 1).Value = Sheets("Sheet1").Cells(X, 1).Value
Cnt = Cnt + 1
End If

ElseIf LVValue = "2" Then
Exit For

End If

'Save current status - 3:On A:Nop Others:Off
If LVValue = "3" Then
CopyValue = True
ElseIf LVValue = "A" Then
Else
CopyValue = False
End If
Next X

End Sub
``````