Question

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

我的代码的基本原理是根据A列中的ID（来自txtbox中输入的条件）搜索以及查找条目; 如果该行符合搜索条件则我希望该条目的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

代码没有给出任何调试错误，但是当我按下搜索按钮时，它也没有执行任何。我认为我正在努力的领域是定义数组，并且添加每个条目，因为find-function循环遍历表（即最后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

将Find-function的结果（包括每个结果的额外列）放入数组vba

1 个答案: