此代码现在正在搜索多个工作表中的多个值。
如何在不必每次写入的情况下同时搜索多个值。例如,我想在列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行很多数字,然后我想点击搜索一次只能在同一时间给我所有值的搜索。我不想点击一个搜索不止一次。
答案 0 :(得分:0)
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