VBA 替換字符串 EXCEL 2019

Question

我無法提取給定地址單元格的郵政編碼，如下所示：

“108, avenue du Grand Sud 37 170 CHAMBRAY les TOURS”。

我用過：

=RECHERCHE(9^9;--("0"&STXT(A2;MIN(CHERCHE({0.1.2.3.4.5.6.7.8.9};A2&"0 123456789"));LIGNE($1:$100))))

有時可行，有時不取決於地址開始的街道號碼（此處為“108”）。

問題是模式“37 170”的空間。 我想刪除模式中的空白。 有沒有一種正則表達式方法來搜索這個模式“## ###”，然后刪除這個有毒的空格？

謝謝你的詭計。

我試過這段代碼：

Function toto(r, Optional u = 0)
Application.Volatile
Dim i%, j%, adr$, cp$, loca$, x
  x = Split(r)
  For i = 0 To UBound(x)
    If x(i) Like "#####" Then Exit For
  Next
  If i > UBound(x) Then
    adr = r.Value 'facultatif
  Else
    cp = x(i)
    For j = 0 To i - 1: adr = adr & x(j) & " ": Next
    adr = Left$(adr, Len(adr) + (Len(adr) > 1))
    For j = i + 1 To UBound(x): loca = loca & x(j) & " ": Next
    loca = Left$(loca, Len(loca) + (Len(loca) > 1))
  End If
  x = Array(adr, cp, loca)
  If 0 < u And u < 4 Then toto = x(u - 1) Else toto = x
End Function

上面的代碼適用於拆分地址，包括街道號碼、zip 代碼和城市名稱。 但當 zip 代碼為## ### = 2 位 integer - 空格 - 3 位 integer 時，它不起作用。

編輯： 2021 年 6 月 1 日

既然我的問題似乎不夠清楚，讓我們改寫一下：

給定一個 Excel 工作表，其中包含 A 列的每個單元格，從 A1 到 A10000，完整的地址如下：

“2 rue Rene cassin Centre Commercial Châlon 2 Sud 71 100 CHALON SUR SAONE”或這個：“15, Rue Emile Schwoerer 68 000 COLMAR”

其中“71 100”和“68 000”是格式不正確的 zip 代碼，因為前 2 個數字和最后 3 個數字之間有多余的空格。

我需要拆分 Ai 單元格內容以獲得：

• 在單元格 Bi 中：文本（街道等）放在“錯誤”zip 代碼的前 2 個數字之前的左側，
• 在單元格 Ci：zip 代碼及其正確格式（“71100”而不是“71 100”），
• 在單元格 Di：zip 代碼后的文本（城市名稱）。

是圍繞zip代碼左右提取的一種。

我發布的上述代碼不起作用。

為了獲得正確的 zip 代碼格式，我嘗試了 function 之后的正則表達式：

Function FindReplaceRegex(rng As Range, reg_exp As String, replace As String)
    Set myRegExp = New RegExp
    myRegExp.IgnoreCase = False
    myRegExp.Global = True
    myRegExp.Pattern = reg_exp
    
    FindReplaceRegex = myRegExp.replace(rng.Value, replace)
End Function

但我無法確定正確的正則表達式模式以消除 zip 代碼中的空間。 PEH 給了我以下模式：

(.*)([0-9]{2}?[0-9]{3})(.*)

使用 function 時，我嘗試通過以下方式定義替換模式：

(.*)([0-9]{2}[0-9]{3})(.*)

但這行不通。 希望這能澄清我的問題。

歡迎任何想法。 謝謝

Answer 1

如果這些輸入字符串始終具有相同的模式，請嘗試：

=CONCAT(FILTERXML("<t><s>"&SUBSTITUTE(A1," ","</s><s>")&"</s></t>","//s[.*0=0]"))

根據您的需要/邊緣情況，您可以添加更多 xpath 表達式。

Answer 2

如果這是 VBA，我有一個解決方案（請原諒蹩腳的命名約定，我在等待 SQL 刷新時在工作中草草寫下）：

Sub test1()

a0 = Cells(1, 1)  'Get the text, in this case "108, avenue du Grand Sud 37 170 CHAMBRAY les TOURS"
aa = Replace(a0, ",", " ")  'Make all delimiters of same type, so removing commas, you may need to add more replace work here?
ab = Application.Trim(aa)  'Reduce all whitespace to single entries, i.e. " " rather than "  "
ac = Split(ab, " ", -1)  'Now split by that single whitespace entry

Dim txt()

i2 = 0
lastIsNumeric = False
For i1 = 0 To UBound(ac) - 1  'Step through each entry in our "split" list

    If IsNumeric(ac(i1)) = True And IsNumeric(ac(i1 + 1)) = True Then     
        'Two numbers back to back, join
        ReDim Preserve txt(i2)
        txt(i2) = ac(i1) + ac(i1 + 1)
        i2 = i2 + 1
        i1 = i1 + 1
    Else
        'Not two numbers back to back, don't join
        ReDim Preserve txt(i2)
        txt(i2) = ac(i1)
        i2 = i2 + 1
    
    End If

Next i1


If IsNumeric(ac(UBound(ac))) = False Then
    'Need to add last entry to txt()
    ReDim Preserve txt(UBound(txt) + 1)
    txt(UBound(txt)) = ac(UBound(ac))
End If

End Sub

編輯 2021-06-01：以上將生成您地址中所有條目的列表 (txt)。 然后，您可以根據需要重新組裝，或僅提取郵政編碼。

如果您希望它是 function，那么它將是：

Public Function getPostcode(a0)

aa = Replace(a0, ",", " ")
ab = Application.Trim(aa)
ac = Split(ab, " ", -1)

Dim txt()

i2 = 0
lastIsNumeric = False
For i1 = 0 To UBound(ac) - 1
    If IsNumeric(ac(i1)) = True And IsNumeric(ac(i1 + 1)) = True Then
        'Two numbers back to back, join
        ReDim Preserve txt(i2)
        txt(i2) = ac(i1) + ac(i1 + 1)
        i2 = i2 + 1
        i1 = i1 + 1
    Else
        'Not two numbers back to back, don't join
        ReDim Preserve txt(i2)
        txt(i2) = ac(i1)
        i2 = i2 + 1
    
    End If

Next i1


If IsNumeric(ac(UBound(ac))) = False Then
    'Need to add last entry to txt()
    ReDim Preserve txt(UBound(txt) + 1)
    txt(UBound(txt)) = ac(UBound(ac))
End If

'Re-assemble string for return
rtnTxt = ""
For i1 = 0 To UBound(txt)
    rtnTxt = rtnTxt & " " & txt(i1)
Next i1

getPostcode = rtnTxt

End Function