将查找函数的结果（包括每个结果的额外列）放入数组 vba

Question

这个问题是基于我前几天在论坛上得到的提示，但是由于这完全改变了问题，我正在创建一个新的 post（这似乎比我的解决方案好得多建议，但我遇到了一些问题）。

我的代码的基本原理是 search 并 find 基于 A 列中的 ID 的条目（来自 txtbox 中输入的条件） ; if 该行符合搜索条件 then 我希望该条目的 A 列到 J 列的数据存储在 动态数组。所有匹配的条目都将存储在那里。该数组将用于在用户表单的 列表框 中显示所有相关条目。

代码如下：

Private Sub cmdFind_Click()
Dim sht As Worksheet
Dim lastrow As Variant
Dim strSearch As String
Dim aCell As Range
Dim row_number As Integer
Dim item_in_review As Variant
Dim y As Integer
Dim Arr() As Variant

y = lstSearch.ListCount


Set sht = ActiveWorkbook.Sheets("a")
lastrow = sht.Range("A" & Rows.Count).End(xlUp).Row
strSearch = txtSearch.Text
    Set aCell = sht.Range("A1:A" & lastrow).Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

      If Not aCell Is Nothing Then
         GoTo wfrefvalid
     Else
MsgBox "Oops! That Work File does not exist. Please try again.", Title:="Try again"
txtSearch.Value = ""
        End If
    Exit Sub

wfrefvalid:
row_number = 0
'clears the listbox so that you have dont have a continuously growing list
lstSearch.Clear
Do
DoEvents
row_number = row_number + 1
ReDim Preserve Arr(item_in_review + 1)
item_in_review = sht.Range("A" & row_number)
If item_in_review = txtSearch.Text Then
Arr = item_in_review.Range("A" & row_number & ":J" & row_number)
End If
Loop Until item_in_review = ""

lstSearch.List = Arr

End Sub

代码没有给出任何调试错误，但是当我按下搜索按钮时它也没有做任何事情。我认为我正在努力的领域是定义数组，并且添加每个条目作为查找函数循环通过 table （即最后 12 个左右代码段）。

有人对将搜索中的数据（包括额外的列）添加到数组有任何提示吗？

Answer 1

我想代码应该是这样的。

Private Sub cmdFind_Click()
Dim sht As Worksheet
Dim lastrow As Variant
Dim strSearch As String
Dim aCell As Range
Dim row_number As Integer
Dim item_in_review As Variant
Dim y As Integer
Dim Arr() As Variant
Dim rngDB As Range
Dim strAddress As String, n As Long

y = lstSearch.ListCount


Set sht = ActiveWorkbook.Sheets("a")
lastrow = sht.Range("A" & Rows.Count).End(xlUp).Row
Set rngDB = sht.Range("a1", "a" & lastrrow)
strSearch = txtSearch.Text
    With rngDB
        Set aCell = .Find(What:=strSearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
          If Not aCell Is Nothing Then
            strAddress = aCell.Address
            Do
                n = n + 1
                ReDim Preserve Arr(1 To 10, 1 To n)
                For i = 1 To 10
                    Arr(i, n) = aCell(1, i)
                Next i
                Set aCell = .FindNext(aCell)
            Loop While strAddress <> aCell.Address

         Else
            MsgBox "Oops! That Work File does not exist. Please try again.", Title:="Try again"
            txtSearch.Value = ""
        End If
    End With
    If n = 1 Then
        lstSearch.List = Arr
    ElseIf n > 1 Then
        lstSearch.List = WorksheetFunction.Transpose(Arr)
    End If
End Sub

将查找函数的结果（包括每个结果的额外列）放入数组 vba

Put results from Find-function (including extra columns for each result) into array vba

arrays

excel

vba

listbox

userform