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，但这会返回第2行，无论它是1还是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块。我无法看到宏中使用该格式的其他任何地方。

Excel VBA - 添加＆＃39;如果在第一行中为0＆＃39;到现有宏

1 个答案: