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

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

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

然后在第一个for循环中执行另一个for循环，该循环遍历所有行，并将所有与发票号匹配的行移动到CStr（xRg（K）.Value）=“paid”之后插入。当前电子表格图像。下面是我正在使用的代码。该图像是电子表格的一小部分。在示例中，Sarah Phillips在第9-12行中有数据，在第9行的A列中有“已支付”状态。我需要所有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行标记为“paid”并执行宏时，具有匹配发票号的行都将被移动

---

我建议进行以下更改

• 对循环使用

  。这更容易，你也能更容易地跟随

• 删除宏末尾的行。这可以通过下面代码中的

  KillRnG

  完成
• 您可以使用偏移量从匹配行的其他列收集信息。看我的例子

  '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
  

---

我建议进行以下更改
• 对循环使用

  。这更容易，你也能更容易地跟随

• 删除宏末尾的行。这可以通过下面代码中的

  KillRnG

  完成
• 您可以使用偏移量从匹配行的其他列收集信息。看我的例子

  '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
  

---

您通常有多少行数据？我要求使用数组等会更快。但是如果每次只有几行，那么对于每个循环，一个快速的

，也就足够了。如果您正在删除
行
或
列
，请确保您向后工作！数据行是未知的，因为它将取决于联系人员收集数据的次数。您通常有多少行数据？我要求使用数组等会更快。但是如果每次只有几行，那么对于每个

循环，一个快速的

，也就足够了。如果您正在删除
行
或
列
，请确保您向后工作！数据行将是未知的，因为它将取决于联系人员收集数据的次数。