根据住址信息，输出房屋信息

longnose

根据住址信息，输出房屋信息，帮忙写一下vba代码，谢谢。

cnmlgb9998

1. =DROP(REDUCE("",A2:A16,LAMBDA(x,y,LET(_a,TEXTSPLIT(y,TEXTSPLIT(y,SEQUENCE(10)-1,,TRUE),,TRUE),_b,TEXTAFTER(TEXTBEFORE(y,"单元"),"号楼"),_c,INDEX(SEQUENCE(10)-1,MATCH(_b,NUMBERSTRING(SEQUENCE(10)-1,1),0)),VSTACK(x,TEXTJOIN("",TRUE,HSTACK(TAKE(_a,,1),"-"&_c&"-",TAKE(_a,,-1))))))),1)

复制代码

测试无误！ 365专用 ，一步到位。

但，单元号 大于9，会出错。哈哈哈

swl4561255

=SUBSTITUTE(MID(A2,FIND("区",A2)+1,2),"号","")&"-"&MATCH(,0/FIND({"一","二","三","四"}&"单",A2),)&"-"&-LOOKUP(,-RIGHT(A2,ROW($1:$4)))

沈默00

沈默00

365版函数走一个
=LET(a,TEXTSPLIT(A2,{"区","号楼","单","层"}),CHOOSECOLS(a,2)&"-"&MATCH(0,0/FIND({"一","二","三","四","五","六","七","八","九","十"}&"单",A2),0)&"-"&CHOOSECOLS(a,5))

笨鸟飞不高

根据住址输出房屋信息.zip (14.44 KB, 下载次数: 19)

2024-4-27 14:03 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, j&, aMatch As Object, strN$
   
    ar = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    ar(1, 1) = "房屋信息(楼-单元-房间）"
   
    With CreateObject("VBScript.RegExp")
        .Pattern = "(\d+)号楼(.+?)单元.+?(\d+)"
        For i = 2 To UBound(ar)
            If .test(ar(i, 1)) Then
                Set aMatch = .Execute(ar(i, 1))(0)
                strN = aMatch.submatches(1)
                For j = 1 To 9
                    strN = Replace(strN, Mid("一二三四五六七八九", j, 1), j)
                Next j
                ar(i, 1) = aMatch.submatches(0) & "-" & strN & "-" & aMatch.submatches(2)
            Else
                ar(i, 1) = Empty
            End If
        Next i
    End With
   
    [D1].Resize(UBound(ar)) = ar
    Beep
End Sub

gwjkkkkk

请参考附件。。。

cidanji

1. Sub ss()
   
2. Dim r&, ar, i&, j&, s, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. r = Cells(Rows.Count, 1).End(3).Row
   
5. ar = Range("A1:B" & r)
   
6. For i = 1 To 9
   
7.     d(Application.Text(i, "[DBNum1]")) = i
   
8. Next
   
9. With CreateObject("VBScript.RegExp")
   
10.     .Pattern = ".*?(\d+)号楼([一-龢]+)单元.*?(\d+)$"
    
11.     For i = 2 To UBound(ar)
    
12.         s = ar(i, 1)
    
13.         ar(i, 2) = IIf(.Test(s), .Replace(s, "$1-") & d(.Replace(s, "$2")) & .Replace(s, "-$3"), "")
    
14.     Next
    
15. End With
    
16. Range("A1:B" & r) = ar
    
17. End Sub

复制代码

zhangcheng6688

cidanji 发表于 2024-4-27 15:26

regexp留底