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

问题描述：

长时间搜索器，第一次提问者..VBA使用一个字符串数组作为SUBSTRING参数InStr函数（Excel）中

目标： - 分配一个值（城市名）到细胞 - 通过含有地址列环在此基础上偏移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：是否有可能实现标题的建议？

谢谢

简单地用'IsNumeric（Application.Match（cel.Value，ZipA（），0））'代替'InStr（1，cel.Value，ZipA（））''，它会起作用（其他城市也一样）。但是，如果所有的邮政编码都在各自城市的二维表中，那么速度会更快，这样您可以像使用公式一样来完成：'cel.Offset（0，6）.Value = Sheets（“MyZips”）。单元格（Application.Match（cel.Value，Sheets（“MyZips”）.Columns（1），0），2）';） –

答

您需要将数组转换为字符串才能使用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

我不确定发生了什么，但是这不幸没有奏效。它把城市价值投入到它不应该拥有的许多细胞中。我可能没有正确执行。请在上面的user3598756的帖子中查看我的意见，以便对我的问题作进一步的说明 - 我认为我最初并没有详细解释它。 – Kaelen

@Kaelen见编辑。 –

它的工作！非常感谢，这将在未来真正帮助我！我不知道你可以在另一个嵌套一个For Each循环。虽然它可能不是最有效的方法，但我认为我会坚持下去，直到我学到更多。非常感谢，朋友。 – Kaelen

答

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

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

感谢所有回复。特别是在这篇文章中的一些真棒技巧。我对大部分建议都进行了修改，但无济于事。我将不得不暂时搁置一段时间，重新审视何时能够专注并确定我忽略的可能是显而易见的错误。此外，我认为我可能不会以足够详细的方式解释我的方法，以找到适当的解决方案。我应该回来。 – Kaelen

我不能使用包含邮政编码的字符串在SrchRng单元内搜索匹配的子字符串，因为（据我所知）每个单元格都包含一个完整的地址 - 即：1234 Drury Ln，Gingertown，PA 55555 如果我是没有错，拉链必须被隔离才能返回真实。空间不足 - 继续低于 – Kaelen

我真的想确定在每个单元格的完整地址字符串中存在4组子字符串（ZipA，ZipB，ZipC，ZipB）中的哪一个子字符串。这是我的逻辑背后，将单元格作为字符串与拉链数组进行比较，作为潜在的子字符串（也是我使用数组后的逻辑 - 用于搜索的子字符串的隔离） – Kaelen

答

解决方案很简单 - 循环！感谢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

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

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

相关推荐