同时搜索多个值

时间:2016-02-25 10:30:40

标签: excel vba excel-vba

此代码现在正在搜索多个工作表中的多个值。

如何在不必每次写入的情况下同时搜索多个值。例如,我想在列A中放入我的所有搜索值,然后单击搜索,它应该搜索并同时为所有这些值赋值。我应该在代码中更改什么来执行此功能?

请参阅代码和图片。

'Definning variables
 Dim i, j, k, l, m, n, no_sheets As Integer
 Dim key, cursor, sheetname As String
 Dim flag As Boolean
 Dim sheet1_count, sheet1_row, row_count As Integer


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

     no_sheets = 4 ' 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)
                  ThisWorkbook.Worksheets("sheet1").Range("G" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("G" & j)
                  ThisWorkbook.Worksheets("sheet1").Range("H" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("H" & j)
                  ThisWorkbook.Worksheets("sheet1").Range("I" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("I" & j)
                  ThisWorkbook.Worksheets("sheet1").Range("J" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("J" & j)
                  ThisWorkbook.Worksheets("sheet1").Range("K" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("K" & j)
                  ThisWorkbook.Worksheets("sheet1").Range("L" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("L" & j)
                  ThisWorkbook.Worksheets("sheet1").Range("M" & sheet1_row) = ThisWorkbook.Worksheets(sheetname).Range("M" & 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"
                  ThisWorkbook.Worksheets("sheet1").Range("F" & sheet1_row) = "Not found"
                  ThisWorkbook.Worksheets("sheet1").Range("G" & sheet1_row) = "Not found"
                  ThisWorkbook.Worksheets("sheet1").Range("H" & sheet1_row) = "Not found"
                  ThisWorkbook.Worksheets("sheet1").Range("I" & sheet1_row) = "Not found"
                  ThisWorkbook.Worksheets("sheet1").Range("J" & sheet1_row) = "Not found"
                  ThisWorkbook.Worksheets("sheet1").Range("K" & sheet1_row) = "Not found"
                  ThisWorkbook.Worksheets("sheet1").Range("L" & sheet1_row) = "Not found"
                  ThisWorkbook.Worksheets("sheet1").Range("M" & 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 pleas, to understand what I mean 我想在搜索表(第一张)中放入A行很多数字,然后我想点击搜索一次只能在同一时间给我所有值的搜索。我不想点击一个搜索不止一次。

2 个答案:

答案 0 :(得分:0)

首先是tipp。

Dim i, j, k, l, m, n, no_sheets As Integer
Dim key, cursor, sheetname As String
Dim flag As Boolean
Dim sheet1_count, sheet1_row, row_count As Integer

只有最后一个变量才是整数。其他人将是Variant。 有时这可能是个问题。

我认为您需要对数组/ arraylist / collection / dictionary进行Dim,然后检查Value是否在此集合中。这应该有用。

答案 1 :(得分:0)

您可以使用以下代码在多个工作表中搜索特定值,并使用VBA宏代码在结果表中复制相关行

Sub Macro_Click()
Dim i, j, k, l, m, n, no_sheets As Integer
Dim key, cursor, sheetname As String
Dim flag As Boolean
Dim sheet1_row, row_count As Integer
no_sheets = 10
    k = 2
    sheet1_row = 2
    For i = 2 To no_sheets
        key = ThisWorkbook.Worksheets("sheet1").Range("A2")
        flag = False
        sheetname = "Sheet" & i

        row_count = WorksheetFunction.CountA(ThisWorkbook.Worksheets(sheetname).Range("A:A"))
        For j = 2 To row_count
            cursor = ThisWorkbook.Worksheets(sheetname).Range("A" & j)
            If key = cursor Then
                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)
                flag = True
                sheet1_row = sheet1_row + 1
            End If
        Next j
    Next i

        If flag = False Then
                    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