VBA;查找变量的多个实例并将范围复制到另一个 sheet

Question

我目前有一个电子表格选项卡，其中包含不同客户要支付的金额。每个客户通常不止一行。我需要做的是能够 select 这个客户端的所有实例，然后将每个客户端实例的所有数据列复制到另一个选项卡中。目前我只知道如何select记录第一个实例。

例如，我想将 ID 为 1 的所有客户端实例放入另一个选项卡；

数据选项卡

ID 金额

1 英镑 20

2 10 英镑

3 15 英镑

1 英镑 10

2 20 英镑

发票选项卡

ID 金额

1 英镑 20

1 英镑 10

我希望我已经解释得足够好，但如果您需要更多详细信息，请告诉我。我是 VBA 的新手，很抱歉，如果这实际上是一个非常简单的问题。

提前致谢:)

预计到达时间

我试图改编我找到的一段代码，但它根本无法工作；

'What value do you want to find (must be in string form)?

fnd = 1

Set myRange = Worksheets("Data").Range("I:AC")
Set LastCell = Worksheets("Data").Cells(myRange.Cells.Count)

Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)

'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell

'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)

    'Add found cell to rng range variable
      Set rng = Union(rng, FoundCell)

    'Test to see if cycled through to first found cell
     If FoundCell.Address = FirstFound Then Exit Do

  Loop

'Select Cells Containing Find Value
rng.Select

Exit Sub

Answer 1

请试试这个。目前它为每个客户创建多个工作表。如果需要，您应该能够更改行为，一旦您完成代码，这是显而易见的

Sub MakeInvoiceSheets()

    Dim ws As Worksheet, strStartCol As String, strEndCol As String, iStartRow As Integer, iEndRow As Integer
    Dim iClient As String, wsInv As Worksheet, strCompletedClients As String

    iStartRow = 1
    iEndRow = 8
    strStartCol = "A"
    strEndCol = "B"

    Set ws = Sheets("Client")
    strCompletedClients = ","

    For irow = iStartRow + 1 To iEndRow
        iClient = ws.Range(strStartCol & irow).Text

        If InStr(1, strCompletedClients, "," & iClient & ",") <= 0 Then
            ws.Select
            ws.Range("$" & strStartCol & "$" & iStartRow & ":$" & strEndCol & "$" & iEndRow).AutoFilter Field:=1, Criteria1:="=" & iClient
            ws.Range(strStartCol & iStartRow).Select
            ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
            Selection.Copy
            Set wsInv = Sheets.Add(After:=Sheets(Sheets.Count))
            wsInv.Name = "Invoice For Client " & iClient
            wsInv.Paste
            ws.AutoFilterMode = False
            strCompletedClients = strCompletedClients & iClient & ","
        End If
    Next

End Sub

VBA;查找变量的多个实例并将范围复制到另一个 sheet

VBA; Lookup multiple instances of a variable and copy range to another sheet

lookup

vba

match