Excel VBA-將“如果第一行為0”添加到現有宏

Question

我有以下VBA宏-

Sub CopyData()

Application.ScreenUpdating = False

Dim CRow As Integer
Dim CColBRange As String
Dim PColBRange As String
Dim Continue As Boolean

'Select Sheet1
With Sheets("KG9New")
    .Select

'Initialize variables
Continue = True
CRow = 1

While Continue = True

CRow = CRow + 1

'Test B2:
 If CRow = 2 And Cells(CRow, 2).Value = 0 Then
  Range("A" & CStr(CRow) & ":C" & CStr(CRow)).Copy
     Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  CRow = CRow + 1
End If

CColBRange = "B" & CStr(CRow)
PColBRange = "B" & CStr(CRow - 1)

  'Break loop upon finding blank cell.
  If Len(Range(CColBRange).Value) = 0 Then
     Continue = False
  End If

  'Copy first instance of each changing Value in MachineRunning.
  If Range(CColBRange).Value <> Range(PColBRange).Value Then
     Range("A" & CStr(CRow) & ":C" & CStr(CRow)).Copy
     Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  End If

Wend

End With

Application.ScreenUpdating = True

End Sub

基本上，這會掃描表的B列並將值從1更改為0或從0更改為1時將值復制到新工作表中。

我的問題是，這假設第一個值（在B2中）將為1。如果B2 = 0，我希望它返回第2行的值。

我嘗試將初始化的CRow更改為1，但是無論它是1還是2，這都會返回第2行（我猜是因為它與標頭不同）。

有人可以幫我嗎？

Answer 1

如您所想，將CRow更改為1。 如果您永遠不在那個單元，則無法測試B2 。 然后，您只需要執行IF語句。

Sub CopyData()

    Application.ScreenUpdating = False

    Dim CRow As Integer
    Dim CColBRange As String
    Dim PColBRange As String
    Dim Continue As Boolean

    'Select Sheet1
    Sheets("KG9New").Select

    'Initialize variables
    Continue = True
    CRow = 1

    While Continue = True

        CRow = CRow + 1

        'Test B2:
        If CRow=2 and Cells(CRow, 2).value = 0 Then
            CRow = 3
        End if

        CColBRange = "B" & CStr(CRow)
        PColBRange = "B" & CStr(CRow - 1)


        'Break loop upon finding blank cell.
        If Len(Range(CColBRange).Value) = 0 Then
         Continue = False
        End If

        'Copy first instance of each changing Value in MachineRunning.
        If Range(CColBRange).Value <> Range(PColBRange).Value Then
         Range("A" & CStr(CRow) & ":C" & CStr(CRow)).Copy
         Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If

    Wend

    Application.ScreenUpdating = True

End Sub

附加的If語句僅測試我們是否在第2行上，並且該值是否為0。如果是，則將CRow更改為3 ，然后它將繼續。

我還刪除了多余的With塊。 我在宏中使用該格式的其他任何地方都看不到。