VBA 使用字符串数组作为子字符串参数 InStr 函数 (Excel)

Posted 2023-02-22

【中文标题】VBA 使用字符串数组作为子字符串参数 InStr 函数 (Excel)

【英文标题】：VBA Using a String Array as SubString Parameter InStr Function (Excel)

【发布时间】：2016-09-11 02:12:25

【问题描述】：

长期搜索，第一次提问..

目标： - 遍历包含地址的列 - 根据单元格包含的邮政编码为单元格偏移量 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 个字符串数组，每个数组都包含与其所在地区相关的多个邮政编码。我尝试将数组声明为变体并使用拆分无济于事。上面的代码给了我一个类型不匹配的错误，而我尝试过的其他方法要么产生了相同的结果，要么产生了“下标超出范围”

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

TLDR：是否有可能实现标题所暗示的内容？

谢谢

【问题讨论】：

只需将InStr(1, cel.Value, ZipA()) 替换为IsNumeric(Application.Match(cel.Value, ZipA(),0)) 即可使用（其他城市也一样）。但是，如果所有邮政编码都在一个包含各个城市的二维表中会更快，这样你就可以像使用公式一样做到这一点：cel.Offset(0, 6).Value = Sheets("MyZips").Cells(Application.Match(cel.Value,Sheets("MyZips").Columns(1), 0), 2) ;)

【参考方案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

---

编辑

根据您的 cmets，您需要遍历数组中的每个元素以确定每个部分是否在单元格中：

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 的帖子中查看我的 cmets，以进一步澄清我的问题 - 我认为我最初解释得不够详细。

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

【参考方案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）来进一步减少打字

【讨论】：

感谢所有回复的人。特别是这篇文章中的一些很棒的提示。我已经修改了大多数建议，但无济于事。我将不得不留出一些时间并重新审视，当我可以集中精力并确定我忽略的可能明显的错误时。此外，我认为我可能没有足够详细地解释我的方法，无法找到合适的解决方案。我会回来的。

我不能使用包含邮政编码的字符串来搜索 SrchRng 单元格中的匹配子字符串，因为（据我了解）每个单元格都包含一个完整地址 - 即：1234 Drury Ln, Gingertown, PA 55555 如果我没记错的话，必须隔离 zip 才能返回 true。空间不足 - 下面继续

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

【参考方案3】：

解决方案很简单——loopception！感谢 Scott Craner 的回答。以下是我为达到预期结果所做的工作：

-声明一个新的Variant，在本例中为str

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

-在第一个循环中嵌套第二个 For Each 循环，循环遍历数组中的每个元素（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

我确信有一个使用更少内存的更复杂的解决方案；但是，作为初学者，这对我来说非常有用。如果您在谷歌搜索解决方案时偶然发现了这个答案，我绝对建议您阅读所有答案以获得一些很棒的提示和详细解释！