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

【问题标题】：Put results from Find-function (including extra columns for each result) into array vba将 Find-function 的结果（包括每个结果的额外列）放入数组 vba
【发布时间】：2017-11-26 21:42:42
【问题描述】：

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

我的代码的基本原理是根据 A 列中的 ID（来自 txtbox 中的标准输入）搜索并查找条目；如果该行与搜索条件匹配那么我希望将该条目从 A 列到 J 列的数据存储在一个动态数组中。所有匹配的条目都将存储在那里。该数组将用于在用户表单的 listbox 中显示所有相关条目。

代码如下：

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

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

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

【问题讨论】：

Excel 有一组很棒的debugging tools 可以帮助您找到问题。我建议使用 F8 一次执行一行代码。将鼠标悬停在变量上将允许您预览它们的内容。从视图菜单中，即时窗口和本地窗口将帮助您检查代码在做什么以及 Excel 的一般状态。
你的代码在哪里？它需要位于名为“cmdFind”的按钮所在的工作表的 Worksheet 模块中 - 当前是否触发了事件？（因为你说它没有做任何事情）
是的，你是对的。 Item_In_Review 是一个变体，但实际上您正在为它分配一个字符串：Item_In_Review = Sht.Range("A" & Row_Number)。最好将.Value 添加到该行，这样您就不会对分配的内容感到困惑。然后你正确地将该字符串与另一个字符串进行比较。我怀疑他们实际上永远不会匹配，因为如果他们愿意，下一行应该会引发错误。 Item_In_Review 是一个字符串，而不是工作表。如果它是 Ws 名称，您的代码应类似于 Sheets(Item_In_Review)。同样，在该行的末尾添加.Value。
你好@RikSportel。该代码位于按钮和其他控件所在的用户窗体中。代码正在运行，因为当我搜索我知道不存在的 ID 时，调试器从找不到 ID 的消息框（如代码中所示）开始。因此，从技术上讲，代码可能没有错，但它根本没有产生任何结果。调试起来很困难，因为用户表单中还有很多其他代码（其中一些不起作用）。
Arr = Sheets(Item_In_Review).Range("A" & Row_Number & ":J" & Row_Number).Value 会将范围的值分配给 Arr。如果您希望将该范围分配给 Arr(0)，则必须这样说。为此，您还需要一个计数器来记录代码中缺少的 Arr 索引。

标签： arrays vba excel listbox userform

【解决方案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

【讨论】：