Question

我试图让用户搜索最多6种不同类型的字符串（文本）。但是我已经尝试了最多2个，

问题

但我的代码只对第一个执行正确的搜索。但是，fisrt字符串之后的任何搜索都无法实现目标。

目标

代码的目的是让它在speficied行中找到字符串，然后在coloumn中搜索大于零的值，如果这样的话复制整行。

Private Sub btnUpdateEntry_Click()

Dim StringToFind As String
Dim SringToFind2 As String
Dim i As Range
Dim cell As Range

StringToFind = Application.InputBox("Enter string to find", "Find string")
StringToFind2 = Application.InputBox("Enter string to find", "Find string")

With Worksheets("Skills Matrix")
    Set cell = .Rows(1).Find(What:=StringToFind, LookAt:=xlWhole, _
                             MatchCase:=False, SearchFormat:=False)

    If Not cell Is Nothing Then
        For Each i In .Range(cell.Offset(1), .Cells(.Rows.Count, cell.Column).End(xlUp))
            If IsNumeric(i.Value) Then
                If i.Value > 0 Then
                    i.EntireRow.Copy
                    Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
                End If
            End If
        Next i
    Else
        Worksheets("Data").Activate
        MsgBox "String not found"
    End If
End With

End Sub

谢谢

Answer 1

不是存储字符串以搜索单独的变量，而是将它们放入数组中。您可以使用For Each循环遍历数组，因此它非常适合：

Private Sub btnUpdateEntry_Click()

Dim StringsToFind(1 to 6) As String
Dim StringToFind as Variant 'Array's demand that their elements be declared as variants or objects, but we know that the element will be a string
Dim i As Range
Dim cell As Range

'Iterate through your empty array and ask for values:
For Each StringToFind in StringsToFind
    StringsToFind(StringToFind) = Application.InputBox("Enter string to find", "Find string")
Next StringToFind


With Worksheets("Skills Matrix")

    'Now iterate again to search:
    For Each StringToFind in StringsToFinds
        Set cell = .Rows(1).Find(What:=StringToFind, LookAt:=xlWhole, _
                                 MatchCase:=False, SearchFormat:=False)

        If Not cell Is Nothing Then
            For Each i In .Range(cell.Offset(1), .Cells(.Rows.Count, cell.Column).End(xlUp))
                If IsNumeric(i.Value) Then
                    If i.Value > 0 Then
                        i.EntireRow.Copy
                        Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
                    End If
                End If
            Next i
        Else
            Worksheets("Data").Activate
            MsgBox "String not found"
        End If
    Next StringToFind

End With

End Sub

可能还有一些其他内部调整用于循环，所以当你迭代时它是有意义的，但这会让你进入大球场。

Answer 2

类似的解决方案，专为灵活性和速度而设计：

Sub tgr()

    Dim wb As Workbook
    Dim wsSearch As Worksheet
    Dim wsData As Worksheet
    Dim rFound As Range
    Dim rCopy As Range
    Dim rTemp As Range
    Dim aFindStrings() As String
    Dim vFindString As Variant
    Dim sTemp As String
    Dim sFirst As String
    Dim i As Long, j As Long
    Dim bExists As Boolean

    Set wb = ActiveWorkbook
    Set wsSearch = wb.Sheets("Skills Matrix")
    Set wsData = wb.Sheets("Data")
    ReDim aFindStrings(1 To 65000)
    i = 0

    Do
        sTemp = vbNullString
        sTemp = InputBox("Enter string to find", "Find string")
        If Len(sTemp) > 0 Then
            bExists = False
            For j = 1 To i
                If aFindStrings(j) = sTemp Then
                    bExists = True
                    Exit For
                End If
            Next j
            If Not bExists Then
                i = i + 1
                aFindStrings(i) = sTemp
            End If
        Else
            'User pressed cancel or left entry blank
            Exit Do
        End If
    Loop

    If i = 0 Then Exit Sub  'User pressed cancel or left entry blank on the first prompt

    ReDim Preserve aFindStrings(1 To i)
    For Each vFindString In aFindStrings
        Set rFound = Nothing
        Set rFound = wsSearch.Rows(1).Find(vFindString, wsSearch.Cells(1, wsSearch.Columns.Count), xlValues, xlWhole)
        If Not rFound Is Nothing Then
            sFirst = rFound.Address
            Do
                For Each rTemp In wsSearch.Range(rFound.Offset(1), wsSearch.Cells(wsSearch.Rows.Count, rFound.Column).End(xlUp)).Cells
                    If IsNumeric(rTemp) And rTemp.Value > 0 Then
                        If rCopy Is Nothing Then
                            Set rCopy = rTemp.EntireRow
                        Else
                            Set rCopy = Union(rCopy, rTemp.EntireRow)
                        End If
                    End If
                Next rTemp
                Set rFound = wsSearch.Rows(1).FindNext(rFound)
            Loop While rFound.Address <> sFirst
        Else
            MsgBox "[" & vFindString & "] not found."
        End If
    Next vFindString

    If Not rCopy Is Nothing Then rCopy.Copy wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Offset(1)

End Sub

在excel VBA中搜索多个不同的字符串

2 个答案: