在Excel VBA中search多个不同的string

我试图让用户search最多6个不同types的string（文本）。 不过，我已经试了多达2，

问题

但我的代码只执行第一个正确的search。 但是，任何一个string之后的search都没有达到目的。

目的

代码的目的是为了在查询行中查找string，然后在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

类似的解决scheme，devise灵活性和速度：

 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 

Answer 2

而不是存储您的stringsearch单独的variables，把它们放入一个数组。 你可以使用For Each循环遍历数组，所以这是一个完美的select：

 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 

在第二个循环内部可能还有其他的一些调整，所以当你迭代时它是有意义的，但是这会让你进入大局。