VBA使用字符串数组作为子字符串参数InStr函数（Excel）

时间：2016-05-15 04:01:20

标签： arrays excel vba parameters substring

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

目标：   - 遍历包含地址的列   - 根据单元格包含的邮政编码

为单元格偏移量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个字符串数组，每个数组包含相对于其区域的多个邮政编码。我已经尝试将Arrays声明为Variants并使用Split无济于事。上面的代码给了我一个类型不匹配错误，我试过的其他方法产生相同或“下标超出范围”

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

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

由于

3 个答案:

答案 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

答案 1 :(得分：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）来进一步减少输入

答案 2 :(得分：0)

解决方案很简单 - 循环！感谢Scott Craner的回答。这是我为实现预期结果所做的工作：

-Declare一个新的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

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

相关问题
最新问题