2016-05-15 57 views
3

長時間搜索器,第一次提問者..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:是否有可能實現標題的建議?

謝謝

+0

簡單地用'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)';) –

回答

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 
+0

我不確定發生了什麼,但是這不幸沒有奏效。它把城市價值投入到它不應該擁有的許多細胞中。我可能沒有正確執行。請在上面的user3598756的帖子中查看我的意見,以便對我的問題作進一步的說明 - 我認爲我最初並沒有詳細解釋它。 – Kaelen

+0

@Kaelen見編輯。 –

+0

它的工作!非常感謝,這將在未來真正幫助我! 我不知道你可以在另一個嵌套一個For Each循環。雖然它可能不是最有效的方法,但我認爲我會堅持下去,直到我學到更多。非常感謝,朋友。 – Kaelen

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 

,我還通過兩個變量(valcity),以減少輸入furtherly

+0

感謝所有回覆。特別是在這篇文章中的一些真棒技巧。我對大部分建議都進行了修改,但無濟於事。我將不得不暫時擱置一段時間,重新審視何時能夠專注並確定我忽略的可能是顯而易見的錯誤。此外,我認爲我可能不會以足夠詳細的方式解釋我的方法,以找到適當的解決方案。我應該回來。 – Kaelen

+0

我不能使用包含郵政編碼的字符串在SrchRng單元內搜索匹配的子字符串,因爲(據我所知)每個單元格都包含一個完整的地址 - 即:1234 Drury Ln,Gingertown,PA 55555 如果我是沒有錯,拉鍊必須被隔離才能返回真實。空間不足 - 繼續低於 – Kaelen

+0

我真的想確定在每個單元格的完整地址字符串中存在4組子字符串(ZipA,ZipB,ZipC,ZipB)中的哪一個子字符串。這是我的邏輯背後,將單元格作爲字符串與拉鍊數組進行比較,作爲潛在的子字符串(也是我使用數組後的邏輯 - 用於搜索的子字符串的隔離) – Kaelen

0

解決方案很簡單 - 循環!感謝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 

我肯定存在使用較少存儲器的更復雜的解決方案;但作爲初學者,這對我來說非常合適。如果您在谷歌搜索解決方案時偶然發現了這個答案,我絕對推薦閱讀所有答案,以獲得一些很好的提示&的詳細解釋!

相關問題