使用VBA搜索整個工作簿

Question

我有一個零件數據庫，需要通過搜索來查找所搜索的內容。我創建了一個搜索頁面，該頁面提供了搜索特定列或在每列中搜索的選項。然後打印它在搜索頁面上找到的信息。我已經通過列部分進行了搜索，但我正在努力搜索所有部分。我一直在「AddressArray（j）= Sheets（i）.Range（searchColumn & j + 1）.Value」這一行發現錯誤1004。我認爲它與該行只能搜索列而不是整個工作簿有關，但我不知道如何解決。

下面是代碼

Sub FindAll() 

Range("B19:J1500") = "" 

    Application.ScreenUpdating = False 

    Dim k As Integer, EndPasteLoopa As Integer 
    Dim myText As String, searchRange As String 
    Dim totalValues As Long 
    Dim nextCell As Range 

    k = ThisWorkbook.Worksheets.Count 
    myText = ComboBox1.Value 
    Set nextCell = Range("B20") 
    If myText = "" Then 
     MsgBox "No Address Found" 
     Exit Sub 
    End If 

    Select Case ComboBox2.Value 
     Case "SEARCH ALL" 
      searchRange = Columns("A:J") 
    End Select 

    For i = 2 To k 
     totalValues = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row 
     ReDim AddressArray(totalValues) As String 

     For j = 0 To totalValues 
      AddressArray(j) = Sheets(i).Range(searchRange & j + 1).Value 
     Next j 

     For j = 0 To totalValues 
      If InStr(1, AddressArray(j), myText) > 0 Then 
       EndPasteLoop = 1 
       If (Sheets(i).Range(searchRange & j + 2).Value = "") Then EndPasteLoop = Sheets(i).Range(searchRange & j + 1).End(xlDown).Row - j - 1 
       For r = 1 To EndPasteLoop 
        Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(i).Range("A" & j + r, "I" & j + r).Value 
        Set nextCell = nextCell.Offset(1, 0) 
       Next r 
      End If 
     Next j 
    Next i 
    Debug.Print tc 
    Application.ScreenUpdating = True 

End Sub 

Answer 1

這是後話快速和骯髒的，將介紹如何輕鬆地搜索所有

this = ComboBox2.Value 
dim arr() as variant 
arr = thisworkbook.sheets("yoursheet").usedrange 
for i = lbound(arr,1) to ubound(arr,1) 
     for j = lbound(arr,2) to ubound(arr,2) 
      if arr(i,j) = this then 
       'code for found item 
      end if 
     next j 
next i 

我知道你已經有種這樣做，但我認爲它值得指出的是，它可以以更簡單的方式完成。

Answer 2

這是我收到的代碼，解決了我的問題。

Sub FindOne() 

    Range("B19:J5000") = "" 

    Application.ScreenUpdating = False 

    Dim k As Integer, EndPasteLoopa As Integer, searchColumn As Integer, searchAllCount As Integer 
    Dim myText As String 
    Dim totalValues As Long 
    Dim nextCell As Range 
    Dim searchAllCheck As Boolean 

    k = ThisWorkbook.Worksheets.Count 
    myText = ComboBox1.Value 
    Set nextCell = Range("B20") 
    If myText = "" Then 
     MsgBox "No Address Found" 
     Exit Sub 
    End If 

    Select Case ComboBox2.Value 
     Case "SEARCH ALL" 
      searchAllCheck = True 
     Case "EQUIPMENT NUMBER" 
      searchColumn = 1 
     Case "EQUIPMENT DESCRIPTION" 
      searchColumn = 3 
     Case "DUPONT NUMBER" 
      searchColumn = 6 
     Case "SAP NUMBER" 
      searchColumn = 7 
     Case "SSI NUMBER" 
      searchColumn = 8 
     Case "PART DESCRIPTION" 
      searchColumn = 9 
     Case "" 
      MsgBox "Please select a value for what you are searching by." 
    End Select 

    For I = 2 To k 
     totalValues = Sheets(I).Cells(Rows.Count, "A").End(xlUp).Row 
     ReDim AddressArray(totalValues) As String 

     If searchAllCheck Then 
      searchAllCount = 5 
      searchColumn = 1 
     Else 
      searchAllCount = 0 
     End If 

     For qwerty = 0 To searchAllCount 
      If searchAllCount Then 
       Select Case qwerty 
        Case "1" 
         searchColumn = 3 
        Case "2" 
         searchColumn = 6 
        Case "3" 
         searchColumn = 7 
        Case "4" 
         searchColumn = 8 
        Case "5" 
         searchColumn = 9 
       End Select 
      End If 

      For j = 0 To totalValues 
       AddressArray(j) = Sheets(I).Cells(j + 1, searchColumn).Value 
      Next j 

      For j = 0 To totalValues 
       If InStr(1, AddressArray(j), myText) > 0 Then 
        EndPasteLoop = 1 
        If (Sheets(I).Cells(j + 2, searchColumn).Value = "") Then EndPasteLoop = Sheets(I).Cells(j + 1, searchColumn).End(xlDown).Row - j - 1 
        For r = 1 To EndPasteLoop 
         Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(I).Range("A" & j + r, "I" & j + r).Value 
         Set nextCell = nextCell.Offset(1, 0) 
        Next r 
       End If 
      Next j 
     Next qwerty 
    Next I 
    Debug.Print tc 
    Application.ScreenUpdating = True 
End Sub