VBA使用string数组作为SubString参数InStr函数（Excel）

长时间的search者，首次提问者

目标： – 循环遍历包含地址的列 – 为单元格偏移量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个string数组，每个数组包含相对于其区域的多个邮政编码。 我已经尝试声明数组作为变体和使用拆分无济于事。 上面的代码给了我一个types不匹配的错误，我试过的其他方法要么产生相同的或“下标超出范围”

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

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

谢谢

Answer 1

您需要将数组转换为string才能使用InStr。 为此，使用Join（）方法将数组的所有部分连接成一个string：

  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

如果因为其他原因不需要数组，那么只需使用string：

  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 

最后，一些编码build议：

1）无论使用哪种方法，您都可能想要将search范围缩小到相关的单元格，例如：

 Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeConstants, xlNumbers) ' consider only cells with a constant (ie not a formula result) number value Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeFormulas, xlNumbers)' consider only cells with a "formula" (ie: deriving from a formula) number value Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeConstants, xlTextValues)' consider only cells with a constant (ie not a formula result) string value Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeFormulas, xlTextValues)' consider only cells with a "formula" (ie: deriving from a formula) string value 

2）考虑使用Select Case语法，而不是If-Then-ElseIf-EndIf ， If-Then-ElseIf-EndIf使用Select Case语法，也会导致input较less

 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 

我还采用了两个variables（ val和city ）来进一步减less打字

Answer 3

解决方法很简单 – 环路！ 感谢斯科特Craner的答案。 以下是我做了什么来达到预期的效果：

在这种情况下，声明一个新的变体

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

– 第一个循环遍历数组中的每个元素（str作为子stringsearch条件）中的每个循环，直到search的string（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 

我相信有一个更复杂的解决scheme，使用更less的内存; 但作为初学者，这对我来说是完美的。 如果你在Googlesearch解决scheme时偶然发现了这个答案，我绝对推荐阅读所有答案，以获得一些很棒的提示和详细的解释！