我正在尝试创建自定义搜索表单,但我无法弄清楚如何搜索整个工作簿并将不同的单元格值从找到值的行导出到表单中的不同文本框。
以下是我开始使用的代码:
Private Sub TextBox_Find_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'Calls the FindAllMatches routine as user types text in the textbox
Call FindAllMatches
End Sub
Private Sub Label_ClearFind_Click()
'Clears the find text box and sets focus
Me.TextBox_Find.Text = ""
Me.TextBox_Find.SetFocus
End Sub
Sub FindAllMatches()
'Find all matches on activesheet
'Called by: TextBox_Find_KeyUp event
Dim SearchRange As Range
Dim FindWhat As Variant
Dim FoundCells As Range
Dim FoundCell As Range
Dim arrResults() As Variant
Dim lFound As Long
Dim lSearchCol As Long
Dim lLastRow As Long
If Len(f_FindAll.TextBox_Find.Value) > 1 Then 'Do search if text in find box is longer than 1 character.
Set SearchRange = ActiveSheet.UsedRange.Cells
FindWhat = f_FindAll.TextBox_Find.Value
'Calls the FindAll function
Set FoundCells = FindAll(SearchRange:=SearchRange, _
FindWhat:=FindWhat, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
BeginsWith:=vbNullString, _
EndsWith:=vbNullString, _
BeginEndCompare:=vbTextCompare)
If FoundCells Is Nothing Then
ReDim arrResults(1 To 1, 1 To 10)
arrResults(1, 1) = "No Results"
Else
'Add results of FindAll to an array
ReDim arrResults(1 To FoundCells.Count, 1 To 10)
lFound = 1
For Each FoundCell In FoundCells
arrResults(lFound, 1) = FoundCell.Value
arrResults(lFound, 2) = FoundCell.EntireRow.Cells(2).Value
arrResults(lFound, 3) = FoundCell.EntireRow.Cells(4).Value
arrResults(lFound, 4) = FoundCell.EntireRow.Cells(5).Value
arrResults(lFound, 5) = FoundCell.EntireRow.Cells(6).Value
arrResults(lFound, 6) = FoundCell.EntireRow.Cells(7).Value
arrResults(lFound, 7) = FoundCell.EntireRow.Cells(17).Value
arrResults(lFound, 8) = FoundCell.EntireRow.Cells(18).Value
arrResults(lFound, 9) = FoundCell.EntireRow.Cells(19).Value
arrResults(lFound, 10) = FoundCell.Address
lFound = lFound + 1
Next FoundCell
End If
'Populate the listbox with the array
Me.ListBox_Results.List = arrResults
Else
Me.ListBox_Results.Clear
End If
End Sub
Private Sub ListBox_Results_Click()
'Go to selection on sheet when result is clicked
Dim strAddress As String
Dim l As Long
For l = 0 To ListBox_Results.ListCount
If ListBox_Results.Selected(l) = True Then
strAddress = ListBox_Results.List(l, 9)
ActiveSheet.Range(strAddress).Select
GoTo EndLoop
End If
Next l
EndLoop:
End Sub
Private Sub CommandButton_Close_Click()
'Close the userform
Unload Me
End Sub
我们的想法是能够更新表单中的行信息。 谢谢你的帮助!
答案 0 :(得分:0)
您可能需要做的就是遍历每个工作表范围,找到您要查找的内容。下面这样的内容将遍历每个使用过的纸张范围,就像您在单个纸张的代码中所做的那样,
Dim ws As Worksheet
Dim SearchRange As Range
For Each ws In ActiveWorkbook.Sheets
For Each SearchRange In ws.UsedRange.Cells
'do your stuff
Set FoundCells = FindAll(SearchRange:=SearchRange, .....
'do more stuff
Next SearchRange
Next ws
但是,小心这样做,b / c如果每个范围都很大,可能需要一段时间。如果是这种情况,将数据加载到内存中并循环通过它将会更快。
另外,我会谨慎地命名一个变量SearchRange
,因为它可能会引起一些混淆,可能是srchRange
或类似的东西。