VBA使用一个字符串数组作为SUBSTRING参数InStr函数（Excel）中

Question

长时间搜索器，第一次提问者..

目标： - 分配一个值（城市名）到细胞 - 通过含有地址 列环在此基础上偏移0,6号邮编单元包含

这里就是我有这么远（简称阵列长度）：

Sub LabelCell() 
    Dim SrchRng As Range, cel As Range 
    Dim ZipA() As String 
    Dim ZipB() As String 
    Dim ZipC() As String 
    Dim ZipD() As String 

    ZipA = Array("12345", "12346", "12347", "12348", "12349") 
    ZipB = Array("22345", "22346", "22347", "22348", "22349") 
    ZipC = Array("32345", "32346", "32347", "32348", "32349") 
    ZipD = Array("42345", "42346", "42347", "42348", "42349") 

    Set SrchRng = Range("D6:D350") 

    For Each cel In SrchRng 
     If InStr(1, cel.Value, ZipA()) Then 
      cel.Offset(0, 6).Value = "City 1" 
     ElseIf InStr(1, cel.Value, ZipB()) Then 
      cel.Offset(0, 6).Value = "City 2" 
     ElseIf InStr(1, cel.Value, ZipC()) Then 
      cel.Offset(0, 6).Value = "City 3" 
     ElseIf InStr(1, cel.Value, ZipD()) Then 
      cel.Offset(0, 6).Value = "City 4" 
     End If 
    Next cel 
End Sub 

正如你所看到的，有4个字符串数组，每个都包含多个邮政编码相对到其地区。我试过将数组声明为Variant并使用Split来无济于事。上面的代码给了我一个类型不匹配的错误，我试过的其他方法要么产生相同的或“下标超出范围”

我非常反对定义每个数组的长度和手动分配各个位置作为总数超过400个邮政编码 - 更重要的是，代码看起来很可怕。

TLDR：是否有可能实现标题的建议？

谢谢

Answer 1

您需要将数组转换为字符串才能使用InStr。要做到这一点使用，这将加入阵列的所有部分为一个字符串的Join（）方法：

Sub LabelCell() 
    Dim SrchRng As Range, cel As Range 
    Dim ZipA() 
    Dim ZipB() 
    Dim ZipC() 
    Dim ZipD() 

    ZipA = Array("12345", "12346", "12347", "12348", "12349") 
    ZipB = Array("22345", "22346", "22347", "22348", "22349") 
    ZipC = Array("32345", "32346", "32347", "32348", "32349") 
    ZipD = Array("42345", "42346", "42347", "42348", "42349") 

    Set SrchRng = Range("D6:D350") 


    For Each cel In SrchRng 
     If cel.Value <> "" Then 
      If InStr(1, Join(ZipA), cel.Value) Then 
       cel.Offset(0, 6).Value = "City 1" 
      ElseIf InStr(1, Join(ZipB), cel.Value) Then 
       cel.Offset(0, 6).Value = "City 2" 
      ElseIf InStr(1, Join(ZipC), cel.Value) Then 
       cel.Offset(0, 6).Value = "City 3" 
      ElseIf InStr(1, Join(ZipD), cel.Value) Then 
       cel.Offset(0, 6).Value = "City 4" 

      End If 
     End If 
    Next cel 
End Sub 

---

编辑

根据你的意见，你会需要遍历每个数组中的元素来确定每个部分是在细胞：

Sub LabelCell() 
    Dim SrchRng As Range, cel As Range, str As Variant 
    Dim ZipA() 
    Dim ZipB() 
    Dim ZipC() 
    Dim ZipD() 

    ZipA = Array("12345", "12346", "12347", "12348", "12349") 
    ZipB = Array("22345", "22346", "22347", "22348", "22349") 
    ZipC = Array("32345", "32346", "32347", "32348", "32349") 
    ZipD = Array("42345", "42346", "42347", "42348", "42349") 

    Set SrchRng = Range("D6:D350") 


    For Each cel In SrchRng 
     If cel.Value <> "" Then 
      For Each str In ZipA 
       If InStr(1, cel.Value, str) Then 
        cel.Offset(0, 6).Value = "City 1" 
        Exit For 
       End If 
      Next str 
      For Each str In ZipB 
       If InStr(1, cel.Value, str) Then 
        cel.Offset(0, 6).Value = "City 2" 
        Exit For 
       End If 
      Next str 
      For Each str In ZipC 
       If InStr(1, cel.Value, str) Then 
        cel.Offset(0, 6).Value = "City 3" 
        Exit For 
       End If 
      Next str 
      For Each str In ZipD 
       If InStr(1, cel.Value, str) Then 
        cel.Offset(0, 6).Value = "City 4" 
        Exit For 
       End If 
      Next str 

     End If 
    Next cel 
End Sub 

Answer 2

，如果你不需要其他理由阵列然后只需使用字符串：

Sub LabelCell() 
    Dim SrchRng As Range, cel As Range 
    Dim ZipA As String 
    Dim ZipB As String 
    Dim ZipC As String 
    Dim ZipD As String 

    ZipA = "12345 12346 12347 12348 12349" 
    ZipB = "22345 22346 22347 22348 22349" 
    ZipC = "32345 32346 32347 32348 32349" 
    ZipD = "42345 42346 42347 42348 42349" 

    Set SrchRng = Range("D6:D350") 

    For Each cel In SrchRng 
     If InStr(1, ZipA, cel.Value) Then 
      cel.Offset(0, 6).Value = "City 1" 
     ElseIf InStr(1, ZipB, cel.Value) Then 
      cel.Offset(0, 6).Value = "City 2" 
     ElseIf InStr(1, ZipC, cel.Value) Then 
      cel.Offset(0, 6).Value = "City 3" 
     ElseIf InStr(1, ZipD, cel.Value) Then 
      cel.Offset(0, 6).Value = "City 4" 
     End If 
    Next cel 
    End Sub 

这也更容易编写

应该用数字“规则”我可以推断出你的榜样的实际应用，你也可以去像如下：

Option Explicit 

Sub LabelCell() 
    Dim SrchRng As Range, cel As Range 

    Set SrchRng = Range("D6:D350") 

    For Each cel In SrchRng 
     cel.Offset(0, 6).Value = Choose(cel.Value/10000, "City 1", "City 2", "City 3", "City 4") 
    Next cel 
End Sub 

最后，一些编码意见建议：

1）无论你将使用什么方法，你可能想要将搜索范围缩小到相关的单元格，如：

Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeConstants, xlNumbers) ' consider only cells with a constant (i.e not a formula result) number value 

Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeFormulas, xlNumbers)' consider only cells with a "formula" (i.e.: deriving from a formula) number value 

Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeConstants, xlTextValues)' consider only cells with a constant (i.e not a formula result) string value 

Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeFormulas, xlTextValues)' consider only cells with a "formula" (i.e.: deriving from a formula) string value 

2）考虑使用Select Case语法而不是If-Then-ElseIf-EndIf之一，这也将导致更少的打字

Sub LabelCell() 
    Dim SrchRng As Range, cel As Range 
    Dim ZipA As String, ZipB As String, ZipC As String, ZipD As String 
    Dim val As String, city As String 

    ZipA = "12345 12346 12347 12348 12349" 
    ZipB = "22345 22346 22347 22348 22349" 
    ZipC = "32345 32346 32347 32348 32349" 
    ZipD = "42345 42346 42347 42348 42349" 

    Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeConstants, xlNumbers) 

    For Each cel In SrchRng 
     val = cel.Value 
     Select Case True 
      Case InStr(1, ZipA, val) > 0 
       city = "City 1" 
      Case InStr(1, ZipB, val) > 0 
       city = "City 2" 
      Case InStr(1, ZipC, val) > 0 
       city = "City 3" 
      Case InStr(1, ZipD, val) > 0 
       city = "City 4" 
      Case Else 
       ' code to handle this situation 
     End Select 
     cel.Offset(0, 6).Value = city 
    Next cel 
End Sub 

，我还通过两个变量（val和city），以减少输入furtherly

Answer 3

解决方案很简单 - 循环！感谢Scott Craner的回答。这里我就是这样做，以实现所期望的结果：

-Declare一个新的变种，STR在这种情况下

Dim SrchRng As Range, cel As Range, str As Variant 

-Nest第二对于内的第一回路的每个所述阵列中的通过每个元件的周期（ str作为子字符串搜索标准），直到被搜索的字符串（cel.Value）或者产生匹配，或一个完整迭代返回0

For Each cel In SrchRng 
    If cel.Value <> "" Then 
     For Each str In ZipA 
      If InStr(1, cel.Value, str) Then 
       cel.Offset(0, 6).Value = "City 1" 
       Exit For 
      End If 
     Next str 
Exit For 'etc 

我肯定存在使用较少存储器的更复杂的解决方案;但作为初学者，这对我来说非常合适。如果您在谷歌搜索解决方案时偶然发现了这个答案，我绝对推荐阅读所有答案，以获得一些很好的提示&的详细解释！