使用数组，并使用下面的代码在vba中find多个string？

如何在下面的代码中使用数组来查找多个string？

Sub Replace18() Dim rng As Range Dim rws As Long rws = Range("A" & Rows.Count).End(xlUp).Row - 3 Set rng = Rows("3:3").Find(What:="quantity", LookAt:=xlWhole, MatchCase:=False) If Not rng Is Nothing Then rng.Offset(1, 0).FormulaR1C1 = "20" rng.Offset(1, 0).Resize(rws).FillDown End If End Sub 

Answer 1

另一个变体（基于@Jeeped答案）

 Sub test() Dim Dic As Object, k As Variant, S$, rws&, x&, Rng As Range Set Dic = CreateObject("Scripting.Dictionary") Dic.CompareMode = vbTextCompare S = "Lorem,ipsum,dolor,amet,consectetur,adipiscing,elit,Mauris," & _ "facilisis,rutrum,faucibus,Sed,euismod,orci,rhoncus,tincidunt,elit,eros" For Each k In Split(S, ",") If Not Dic.exists(k) Then Dic.Add k, Nothing Next k rws = Range("A" & Rows.Count).End(xlUp).Row - 3 x = [3:3].Find("*", , , xlByColumns, , xlPrevious).Column For Each Rng In Range([A3], Cells(3, x)) If Dic.exists(Rng.Value) Then Rng.Offset(1, 0).FormulaR1C1 = "20" Rng.Offset(1, 0).Resize(rws).FillDown End If Next Rng End Sub 

要么

 Sub test2() Dim Dic As Object, k As Variant, S$, rws&, x&, Rng As Range Set Dic = CreateObject("Scripting.Dictionary"): Dic.CompareMode = vbTextCompare S = "Lorem,ipsum,dolor,amet,consectetur,adipiscing,elit,Mauris," & _ "facilisis,rutrum,faucibus,Sed,euismod,orci,rhoncus,tincidunt,elit,eros" For Each k In Split(S, ",") If Not Dic.exists(k) Then Dic.Add k, "" Next k rws = Range("A" & Rows.Count).End(xlUp).Row x = [3:3].Find("*", , , xlByColumns, , xlPrevious).Column For Each Rng In Range([A3], Cells(3, x)) If Dic.exists(Rng.Value) Then Range(Cells(Rng.Row + 1, Rng.Column), Cells(rws, Rng.Column)).Value = "20" End If Next Rng End Sub 

Answer 2

设置一个变体数组并循环遍历它们。

 Sub Replace18() Dim rng As Range, rws As Long, w As Long, vWHATs As Variant vWHATs = Array("Lorem", "ipsum", "dolor", "amet", "consectetur", "adipiscing", _ "elit", "Mauris", "facilisis", "rutrum", "faucibus", "Sed", _ "euismod", "orci", "rhoncus", "tincidunt", "elit", "eros") With Worksheets("Sheet2") '<~~set this worksheet reference properly! rws = .Cells.SpecialCells(xlCellTypeLastCell).Row - 3 For w = LBound(vWHATs) To UBound(vWHATs) Set rng = .Rows(3).Find(What:=vWHATs(w), LookAt:=xlWhole, MatchCase:=False) If Not rng Is Nothing Then 'just fill then all at once rng.Offset(1, 0).Resize(rws, 1) = "20" End If Next w End With End Sub 

我已经使用xlCellTypeLastCell选项修改了对“最后一行”的search，以包含Range.SpecialCells方法的所有列。 这适用于我已经包含在With … End With块中的正确引用的父级工作表。 所有的单元格和范围引用在这个块内应该有一个句点（aka或者full stop ）作为前缀，以表明它们属于With … End With引用的工作表。 这包括.Rows(3) ，正如.Find使用前缀周期来指出它正在引用Rows(3) 。

---