excel - 捕获数据，然后在现有代码中创建循环

Question

我创建了一个电子表格，其中包含一个宏，当 A 列中的状态标记为“已付款”时，该宏将删除并移动到新选项卡的一行。我需要更进一步，以便如果状态标记为“已付款”并且 D 列中的发票编号与同一行匹配，那么所有相同的发票 #s 也将被移动到新选项卡。

捕获该行发票编号的代码是什么？

然后在第一个循环中执行另一个 for 循环，该循环遍历所有行并将所有与发票编号匹配的行移动到插入 After If CStr(xRg(K).Value) = "paid"。当前电子表格图像。我正在使用的代码如下。该图像是电子表格的片段。在示例中，Sarah Phillips 的第 9-12 行中的数据在 A 列第 9 行中具有“已付款”状态。我需要具有相同发票编号的所有 4 个数据移动到新的电子表格。

我是编写代码的新手，建议我捕获该行的发票编号，然后在第一个循环内循环遍历所有行并移动这些行。我不知道如何执行此操作或修改当前代码，以便包含该建议。

Sub TransferData()

Dim xRg As Range
Dim xCell As Range
Dim I As Long, J As Long, K As Long

I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
   If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Sheet1").Range("A1:A" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "paid" Then
        xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
        xRg(K).EntireRow.Delete
        If CStr(xRg(K).Value) = "paid" Then
            K = K - 1
        End If
        J = J + 1
    End If
Next
Application.ScreenUpdating = True


 End Sub

我希望当 A 行标记为“已付款”并执行宏时，所有具有匹配发票编号的行都会被移动。

标签： excelvba

Answer 1

我建议进行以下更改。

• 使用For循环。它更容易，您将能够更轻松地跟随。
• 删除宏末尾的行。这可以通过KillRnG下面的代码来完成。

• 您可以使用Offset来从匹配行的其他列中收集信息。看我的例子。

  'If you insert this immediately after you turn off screen 
  'updating you can loop through your rows.
  dim aCell as Range
  For Each aCell In Intersect(Range("A:A", ActiveCell.UsedRange)).Cells
  
      If UCase(aCell.Value) = "PAID" Then
          'do your thing of copying the row to some other other sheet.
  
           'set the row for deletion... this will be done at the end.
            Set killRNG = Union(killRNG, aCell.EntireRow)
  
      Debug.Print "This is the invoice: " & aCell.Offset(0, 3).Value
  End If
  
  Next cell
  
  'This will delete whatever you wanted
  killRNG.ClearContents
  killRNG.Delete