首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >VBA替换字符串EXCEL 2019

VBA替换字符串EXCEL 2019
EN

Stack Overflow用户
提问于 2021-05-31 15:11:31
回答 2查看 201关注 0票数 0

我无法提取给定地址单元的邮政编码,如下所示:

"108,杜格兰南大道370号香格里拉旅游“。

我用过:

代码语言:javascript
复制
=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“的空间。我想删除模式中的空白。有没有一种正则表达式来搜索这个模式"## ###",然后删除这个有毒的空格?

谢谢你的花招。

我试过这段代码:

代码语言:javascript
复制
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

上面的代码可以很好地分割地址,包括街道号码、邮政编码和城市名称。但是当邮政编码是## ### =2位整数-空格-3位整数时,它就不能工作了。

编辑: 01 2021年6月

既然我的问题似乎还不够清楚,让我们换个说法:

如果在A列的每个单元格中都包含了一个Excel工作表,从“A1”到“A10000”,完整的地址如下:

"2 Rene cassin Centre Schwoerer lon 2 Sud 71 100 CHALON SUR SAONE“或这一条:"15,Emile Schwoerer街68 000 COLMAR”

其中"71 100“和"68 000”是一个不正确格式的邮政编码,因为两个第一位数字和三个最后一个数字之间有额外的空格。

我需要拆分Ai单元的内容,以便获得:

  • in cell Bi :文本(街道等)放置左前两个数字的“错误”邮政编码,
  • 在单元格Ci :邮政编码与其正确的格式("71100“而不是"71 100"),
  • 在单元格Di :文字(城市名称)后的邮政编码.

这是一种左右提取的邮政编码。

我贴出的上述代码不起作用。

为了获得正确的邮政编码格式,我尝试了regex以下函数:

代码语言:javascript
复制
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

但是,我无法确定正确的正则表达式模式,以去掉邮政编码中的空格。PEH给了我以下模式:

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

在使用该函数时,我试图通过以下方法定义替换模式:

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

但这行不通。希望这能澄清我的问题。

任何想法都是欢迎的。谢谢

EN

回答 2

Stack Overflow用户

回答已采纳

发布于 2021-05-31 15:28:08

如果这是VBA,我为您提供了一个修复程序(请原谅糟糕的命名约定,我在工作中草草地记下了这一点,同时等待SQL刷新):

代码语言:javascript
复制
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)。如果你愿意的话,你可以重新组装,或者只提取邮政编码。

如果您希望它作为一个函数,那么它将是:

代码语言:javascript
复制
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
票数 1
EN

Stack Overflow用户

发布于 2021-05-31 15:37:38

如果这些输入字符串总是具有相同的模式,请尝试:

代码语言:javascript
复制
=CONCAT(FILTERXML("<t><s>"&SUBSTITUTE(A1," ","</s><s>")&"</s></t>","//s[.*0=0]"))

根据您的需要/边缘情况,可以添加更多的xpath表达式。

票数 3
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/67776320

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档