在Excel VBA中搜索多个不同的字符串 [英] Search Multiple different string in excel VBA

问题描述

我正在尝试允许用户搜索多达6种不同类型的字符串(文本).但是我已经尝试了最多2次，

i am trying to allow the user to search up to 6 different types of strings( text). However i have tried it for up to 2 ,

问题

但是我的代码仅对第一个进行正确的搜索.但是，在fisrt字符串之后进行的任何搜索均无法达到目标.

but my code only performs the search correctly for the first one. However any of the searches after fisrt string are not achieving the objective.

客观

代码的目的是要在指定的行中找到字符串，然后在该列中搜索大于零的值(如果这样，则复制整个行).

The objective of the code is for it to find the string in the speficied row, then search that coloumn for values greater than zero, if so copy the whole row.

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

谢谢

推荐答案

类似的解决方案，旨在提高灵活性和速度:

Similar solution, designed for flexibility and speed:

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中搜索多个不同的字符串的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！