搜索匹配兩次相同列的2個關鍵字并將結果復制到另一個作業表

我被卡住了，我不知道要使用什么代碼，因此我可以在同一列中搜索 2 個不同的關鍵字兩次，然后從起始單元格按順序將資料從同一行復制到另一個電子表格。有關詳細資訊，這就是我正在嘗試做的事情。

1. 將搜索限制在作業表的范圍內（例如作業表 1 B1:N:200）
2. 在限制范圍Sheet1的第8列（I）中搜索關鍵字（“商品”）
3. 復制在找到 實體“Goods”的同一行的第 2 (C) 和第 5 列 (F)中找到的資料
4. 將第 1 頁的值- 第 2 列粘貼到第 2 列 - 第 3 列（僅無格式值），將第 1 列第 5 列粘貼到特定起點（例如第 2 頁 - B3）上的第 2 列第 4 列（帶有格式和值）比賽結果將是 Sheet 2 - B4 等等

5.再次在 Sheet1 的第 8 列搜索關鍵字（“Services”），從頂部開始（B1:N1）

6.復制在找到 實體“服務”的同一行的第 2 (C) 和第 5 列 (F) 中找到的資料

7. 在“商品”的最后一次粘貼完成后，將第 1 頁的值- 第 2 列粘貼到第 2 列 - 第 3 列（僅無格式值），將第 1 列第 5 列粘貼到第 2 列第 4 列（帶有格式和值）到下一行。（例如，最后一行匹配粘貼是 C35 和 D35 新發現的值應粘貼在 C36 a D36 中）結束輸出應首先是所有“商品”結果，然后是“服務”結果

我希望我已經清楚地表達了我的需要

我正在嘗試處理我在這里找到的這段代碼，但我只是不知道如何為服務插入第二個搜索回圈。，如何粘貼到 sheet2 中的特定單元格，如何跟隨最后一行粘貼服務

        Sub CopyCells
    
    Dim lngLastRowSht1 As Long
    
    Dim lngLastRowSht2 As Long
    
    Dim counterSht1 As Long
    Dim counterSht2 As Long
    
    
    With Worksheets(1)
    
        lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row
    
        lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
    
            For counterSht1 = 1 To lngLastRowSht1
    
                For counterSht2 = 1 To lngLastRowSht2
    
                    If Sheets(1).Range("" & (counterSht1)).Value = "Goods" Then
    
                        Sheets(2).Range("B" & (counterSht2), "D" & (counterSht2)).Value = Sheets(1).Range("C" & counterSht1, "D" & counterSht1).Value
    
                                        End If
    
                Next counterSht2
    
            Next counterSht1
    
            
    
    End With
    
    End Sub

編輯1

根據克里斯爵士的要求，它應該是這樣的

這個查詢的答案最好由@CDP1802 解決，按需作業。

我了解到我需要 2 個計數器才能作業 :) 并且我還學習了如何正確標記目標目的地。

感謝這個社區：）

uj5u.com熱心網友回復：

在每次復制后增加目標行。

Option Explicit
Sub CopyCells()

    Const ROW_START = 3

    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim n As Long, r As Long, lastrow1 As Long, lastrow2 as Long
    Dim keywords, word, t0 As Single: t0 = Timer
    keywords = Array("Goods", "Services")
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets(1)
    Set ws2 = wb.Sheets(2)
    lastrow2 = ROW_START
    
    Application.ScreenUpdating = False
    With ws1
        lastrow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
        For Each word In keywords
            For r = 1 To lastrow1
                If Len(.Cells(r, "I")) = 0 Then
                    Exit For
                ElseIf .Cells(r, "I") = word Then
                    'Sht1 col 2 to Sht2 Col 3 (no format values only)
                    'Sht1 col 5 to Sht2 Col 4 (with format and values)
                    ws2.Cells(lastrow2, "C") = .Cells(r, "B")
                    ws2.Cells(lastrow2, "D") = .Cells(r, "E")
                    .Cells(r, "E").Copy
                    ws2.Cells(lastrow2, "D").PasteSpecial xlPasteFormats
                    lastrow2 = lastrow2   1
                    n = n   1
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
    
    MsgBox r - 1 & " rows scanned " & vbLf & n & " rows copied", _
    vbInformation, Format(Timer - t0, "0.0 secs")
End Sub

uj5u.com熱心網友回復：

你可以做兩個例程：一個是服務，一個是商品。但是該代碼和上面的代碼效率不高。

由于服務和商品在同一列中，請嘗試使用自動過濾器：

Sheets(2).UsedRange.autofilter Field:=8, Criteria1:=Array("Goods", "Services"), VisibleDropDown:=False, Operator:=xlFilterValues
Sheets(2).UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(1).Range("A1").PasteSpecial
Application.CutCopyMode = False

標籤：擅长 vba 比赛

上一篇：如何將變數連接到范圍快捷方式[]？

下一篇：括號中的WordVBA宏