Question

我有一个部件数据库，我需要搜索以查找搜索到的内容。我创建了一个搜索页面，提供搜索特定列或在每列中搜索的选项。然后它会在搜索页面上打印出它找到的信息。我通过列部分完成搜索，但我正在努力搜索所有部分。我在第34行继续收到错误1004; AddressArray（j）= Sheets（i）.Range（searchColumn＆amp; j + 1）.Value＆＃34;。我认为它与该行有关的只是搜索列而不是整个工作簿，但我不知道如何解决它。

这是代码

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

使用VBA搜索整个工作簿

2 个答案: