如何使用多維數組搜索多個值？

Question

此代碼現在可以在多個工作表中搜索多個值。 我如何解決它，以支持同時搜索多個值，而無需編寫每一個值。例如，我想在A列中放置所有搜索值，然後單擊搜索，並且它應該同時搜索併爲所有這些值賦予值。我應該在代碼中更改以執行此功能？ 請參閱代碼和圖像。

Dim i, j, k, l, m, n, no_sheets As Variant 
Dim key, cursor, sheetname As Variant 
Dim flag As Variant 
Dim sheet1_count, sheet1_row, row_count As Integer 
Dim Arr() As Variant 

    sheet1_count = WorksheetFunction.CountA(ThisWorkbook.Worksheets("sheet1").Range("A:A")) 

    no_sheets = 3 ' Number of sheets 
    k = 2 
    sheet1_row = sheet1_count 'My start in result sheet 

    key = ThisWorkbook.Worksheets("sheet1").Range("A" & sheet1_count) ' The value that the user will put in searching sheet in column A 

    For i = 2 To no_sheets ' sheet2 then sheet3 then sheet4 then sheet5 ..etc 
     flag = False 
     sheetname = "Sheet" & i 
     row_count = WorksheetFunction.CountA(ThisWorkbook.Worksheets(sheetname).Range("A:A")) ' It's a counter that will contain the range of row A in each sheet 
    For j = 1 To row_count 'I'll start from row 1 until the last sheet 
     cursor = ThisWorkbook.Worksheets(sheetname).Range("A" & j) 'Searching in column A in each sheet (1st row - last row) and put the value in this variable 
      If key = cursor Then ' If the entering value in sheet1 equal the value that we have in current sheet, do the following 
      ' Copying the data 

      flag = True ' The data found 

        ThisWorkbook.Worksheets("sheet1").Range("A" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("A" & j) 
        ThisWorkbook.Worksheets("sheet1").Range("B" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("B" & j) 
        ThisWorkbook.Worksheets("sheet1").Range("C" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("C" & j) 
        ThisWorkbook.Worksheets("sheet1").Range("D" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("D" & j) 
        ThisWorkbook.Worksheets("sheet1").Range("E" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("E" & j) 
        ThisWorkbook.Worksheets("sheet1").Range("F" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("F" & j) 

       sheet1_row = sheet1_row + 1 
       Else 

     End If 
    Next j 'Go to the next row 
Next i 'Go to the next sheet 
    MsgBox "finished, Do another search..!" 


      If key <> cursor Then 
       flag = False ' If the value not found 

        ThisWorkbook.Worksheets("sheet1").Range("B" & sheet1_row) = "Not found" 
        ThisWorkbook.Worksheets("sheet1").Range("C" & sheet1_row) = "Not found" 
        ThisWorkbook.Worksheets("sheet1").Range("D" & sheet1_row) = "Not found" 
        ThisWorkbook.Worksheets("sheet1").Range("E" & sheet1_row) = "Not found" 



      End If 



     End Sub 

    Sub MatchUnMatch_Click() 
Dim i, j, k, l, m, n As Integer 
Dim ListA_count, ListB_count, ListC_count, ListD_count, ListE_count As Integer 
Dim key, cursor As String 
Dim flag As Boolean 

ListA_count = WorksheetFunction.CountA(ThisWorkbook.Worksheets("MatchUnmatch").Range("A:A")) 
ListB_count = WorksheetFunction.CountA(ThisWorkbook.Worksheets("MatchUnmatch").Range("B:B")) 
'ListA_count = ThisWorkbook.Worksheets("MatchUnMatch").Range("A2").End(xlDown).Row 
'MsgBox ListA_count & " " & ListB_count 
'======================================================================================================= 
' 
' 
' Matching Logic for List 'A' and List 'B' 
' 
' 
'======================================================================================================= 
k = 2 
For i = 2 To ListA_count 
    key = ThisWorkbook.Worksheets("MatchUnMatch").Range("A" & i) 

    For j = 1 To ListB_count 
     cursor = ThisWorkbook.Worksheets("MatchUnMatch").Range("B" & j) 
     'MsgBox "Key=" & Key & " Cursor=" & cursor 
     If key = cursor Then 
      ThisWorkbook.Worksheets("MatchUnMatch").Range("C" & k) = key 
      k = k + 1 
      Exit For 
     End If 
    Next j 
Next i 

'======================================================================================================= 
' 
' 
' List 'A' items not in List 'B' 
' 
' 
'======================================================================================================= 
ListC_count = WorksheetFunction.CountA(ThisWorkbook.Worksheets("MatchUnmatch").Range("C:C")) 

k = 2 
For i = 2 To ListA_count 
    key = ThisWorkbook.Worksheets("MatchUnMatch").Range("A" & i) 
    flag = False 
    For j = 1 To ListC_count 
     cursor = ThisWorkbook.Worksheets("MatchUnMatch").Range("C" & j) 
     If key = cursor Then 
      flag = True 
      Exit For 
     End If 
    Next j 
    If flag = False Then 
     ThisWorkbook.Worksheets("MatchUnMatch").Range("D" & k) = key 
     k = k + 1 
    End If 
Next i 

'======================================================================================================= 
' 
' 
' List 'B' items not in List 'A' 
' 
' 
'======================================================================================================= 
k = 2 

For i = 2 To ListB_count 
    key = ThisWorkbook.Worksheets("MatchUnMatch").Range("B" & i) 
    flag = False 
    For j = 1 To ListC_count 
     cursor = ThisWorkbook.Worksheets("MatchUnMatch").Range("C" & j) 
     If key = cursor Then 
      flag = True 
      Exit For 
     End If 
    Next j 
    If flag = False Then 
     ThisWorkbook.Worksheets("MatchUnMatch").Range("E" & k) = key 
     k = k + 1 
    End If 
Next i 
End sub 

see the image please, to understand what I mean我希望把在A行尋找片（第一片）多的數字，然後我想在搜索按鈕點擊一次只應該給我在同一再寄一次不要所有的值不想多次點擊一次搜索。 我想請某人爲我解決它。儘快:(

Answer 1

（*）後OP的OP的熱曲之後更新請求的功能，以節省上一次運行的數據，並在標記爲「數據」表未找到號碼「NOT FOUND」

（**）更新EST處理可變數目的更新，以固定FindItems（）函數來處理非連續的單元格範圍列

（***）的

（****）更新爲固定iRow更新在子的Main（）更新爲具有項目

（*****），以在片材，其細胞被搜索「A1」具有相同內容的「基地」片

（******）更新爲具有在所有數據表的列A中搜索的項目，無論該列的標題如何

雖然我在做我的代碼，茱萸的已經給你一個答案這是確定

但是應該你想管理：

• 任何不同數量的「數據」表（即：片材中的任何的「數據」片尋求在其列「A」項數和從相鄰列收集相關數據）

• 的「數量」多次出現

• （*）的功能，以節省已經在「基地」從先前得到的片材運行

• （*）的功能中的「鹼」片標記「未找到」當在任何「數據」未找到數片之前的數據

• （** ）功能來處理可變數量的列

，那麼你可能需要使用下面的代碼

Option Explicit 

Sub main() 

Dim items() As Variant, itemToFind As Variant 
Dim itemsNumber As Long, previousDataNumber As Long, dataShtNumber As Long, iRow As Long, i As Long, j As Integer 
Dim itemsSht As Worksheet, dataShts() As Worksheet 
Dim rngToCopy As Range 
Dim itemFound As Boolean 
Dim columnsNumberToCopyAndPaste As Long 

columnsNumberToCopyAndPaste = 7 '<== here you set the number of columns to be copied form "data" sheet and pasted in "base" sheet 

Set itemsSht = ThisWorkbook.Worksheets("Sheet1") ' this is the "base" sheet you take "numbers" from its column A, starting at row 2 

Call GetItems(itemsSht, items(), itemsNumber, previousDataNumber) ' gather all "numbers" to be searched for in "data" sheets 

Call GetDataWorksheets(dataShts(), ThisWorkbook, "Sheet1", dataShtNumber) ' gather all "data" sheets 

iRow = 1 
For i = 1 To itemsNumber 'loop through "numbers" 

    itemToFind = items(i) ' "number" to be searched for in "data" sheets 
    itemFound = False 
    For j = 1 To dataShtNumber 'loop through "data" worksheets 

     Set rngToCopy = FindItems(dataShts(j), itemToFind, 1, columnsNumberToCopyAndPaste) ' get "data" sheet column 1 cells with "number" along with 'columnsNumberToCopyAndPaste-1' adjacents cells 

     If Not rngToCopy Is Nothing Then ' if found any occurrence of the "number" ... 
      rngToCopy.Copy itemsSht.Cells(1, 1).Offset(previousDataNumber + iRow) ' ... copy it and paste into "base" sheet 
      iRow = iRow + rngToCopy.Count/columnsNumberToCopyAndPaste 'update "base" sheet row offset to paste subsequent cells, if any 
      itemFound = True 
     End If 

    Next j 
    If Not itemFound Then 'if NOT found any occurrence of the "number" ... 
     itemsSht.Cells(1, 1).Offset(previousDataNumber + iRow).Value = itemToFind 
     itemsSht.Cells(1, 2).Offset(previousDataNumber + iRow).Resize(1, columnsNumberToCopyAndPaste - 1).Value = "NOT FOUND" 
     iRow = iRow + 1 
    End If 

Next i 

itemsSht.Columns.AutoFit 

End Sub 


Sub GetItems(itemsSht As Worksheet, items() As Variant, itemsNumber As Long, previousDataNumber As Long) 

With itemsSht 
    previousDataNumber = .Cells(.Rows.Count, 2).End(xlUp).Row - 1 
    itemsNumber = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 - previousDataNumber 
    ReDim items(1 To itemsNumber) As Variant 
    With .Cells(2 + previousDataNumber, 1).Resize(itemsNumber) 
     If itemsNumber = 1 Then 
      items(1) = .Value 
     Else 
      items = WorksheetFunction.Transpose(.Value) 
     End If 
    End With 
End With 

End Sub 


Function FindItems(sht As Worksheet, itemToFind As Variant, columnToSearchFor As Long, columnsToCopy As Long) As Range 
Dim cell As Range, unionRng As Range 
Dim firstAddress As String 

With sht.Columns(columnToSearchFor) 
    Set cell = .Find(What:=itemToFind, LookAt:=xlWhole) 
    If Not cell Is Nothing Then 
     firstAddress = cell.Address 
     Set unionRng = cell.Resize(, columnsToCopy) 
     Do 
      Set unionRng = Union(unionRng, cell.Resize(, columnsToCopy)) 

      Set cell = .FindNext(cell) 
     Loop While Not cell Is Nothing And cell.Address <> firstAddress 
     Set FindItems = unionRng 
    End If 
End With 

End Function 


Sub GetDataWorksheets(shts() As Worksheet, wb As Workbook, noShtName As String, nShts As Long) 
Dim sht As Worksheet 

For Each sht In wb.Worksheets 
    With sht 
     If .Name <> noShtName Then 
      nShts = nShts + 1 
      ReDim Preserve shts(1 To nShts) As Worksheet 
      Set shts(nShts) = sht 
     End If 
    End With 
Next sht 

End Sub 

（*）其實我添加了一個previousDataNumber變量的時候已經有跟蹤數據的日常運行

（**）在columnsNumberToCopyAndPaste = 5你設定了要處理的列數

我把它分成一個「主」子和一些其他的「幫助」子或函數，以便有清晰和更易維護/改變ble代碼。

這個習慣一直幫助我遠遠超過我所能想到我的開始，當我使用的代碼looong潛艇

Answer 2

現在我完全理解了這個問題，我編輯了我的初始腳本，現在它包含一個FINDNEXT循環，在FINDEXT之後，它搜索表單中的所有重複值，直到FINDNEXT。 cell.address與FIND.cell.address相同。要在列「A」中進行搜索，我在查找函數中將表（i）.cells更改爲表（i）.Range（「A：A」）

Sub find_cells() 
Dim find_cell As Range 
Dim colection_items As Collection 
Dim look_up_value As String 

nb_rows = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'count the number of rows with data on sheet(1) 

Set colection_items = New Collection 
For j = 2 To nb_rows 
    colection_items.Add Sheets(1).Cells(j, 1).Value 
Next j 


counter_rows = 2 'the first row on sheet(2) where we start copying data from 

For col = 1 To colection_items.Count 

look_up_value = colection_items(col) 
    For i = 2 To ThisWorkbook.Sheets.Count 
    Sheets(i).Select 
     Set find_cell = Sheets(i).Range("A:A").Find(What:=look_up_value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False) 

      If Not find_cell Is Nothing Then 
       Dim cell_adrs As String 
       cell_adrs = find_cell.Address 'record address of the first instance of the lookup value on the sheet (i) 
       Sheets(1).Cells(counter_rows, 1).Value = find_cell 
       Sheets(1).Cells(counter_rows, 2).Value = find_cell.Offset(0, 1) 'copies data from the cell to the left by one column 
       Sheets(1).Cells(counter_rows, 3).Value = find_cell.Offset(0, 2) 'copies data from the cell to the left by 2 columns 
       'etc 
       counter_rows = counter_rows + 1 

          Do 
           Set find_cell = Sheets(i).Range("A:A").FindNext(find_cell) 'we lookup the next instance on sheet (i) 
             If cell_adrs <> find_cell.Address Then 'if the next value found is different than the first value from sheet(i) 
             Sheets(1).Cells(counter_rows, 1).Value = find_cell 
             Sheets(1).Cells(counter_rows, 2).Value = find_cell.Offset(0, 1) 'copies data from the cell to the left by one column 
             Sheets(1).Cells(counter_rows, 3).Value = find_cell.Offset(0, 2) 'copies data from the cell to the left by 2 columns 
              counter_rows = counter_rows + 1 
              'etc 
             End If 
           Loop Until cell_adrs = find_cell.Address 'when all the values have been found and find_cell goes back to the first value 
          cell_adrs = Empty 
      End If 

    Next i 
Next col 
Sheets(1).Select 
End Sub