標題: [發問] 地址資料分割成多欄 [打印本頁]

---

作者: aer    時間: 2021-11-18 08:19     標題: 地址資料分割成多欄

請問地址資料要分割成多欄 B2、C2公式？謝謝！

[attach]34397[/attach]

[attach]34398[/attach]

---

作者: hcm19522    時間: 2021-11-18 09:36

https://blog.xuite.net/hcm19522/twblog/590127392

---

作者: samwang    時間: 2021-11-18 10:05

回復 1# aer

請測試看看，謝謝
Sub test()
Dim Arr, a, i&
Arr = Range([d1], [a65536].End(3))
For i = 2 To UBound(Arr)
    Arr(i, 2) = Left(Arr(i, 1), 3)
    a = Mid(Arr(i, 1), 4)
    If InStr(a, "鄉") Then
        Arr(i, 3) = Split(a, "鄉")(0) & "鄉"
        Arr(i, 4) = Split(a, "鄉")(1)
    ElseIf InStr(a, "鎮") Then
        Arr(i, 3) = Split(a, "鎮")(0) & "鎮"
        Arr(i, 4) = Split(a, "鎮")(1)
    ElseIf InStr(a, "市") Then
        Arr(i, 3) = Split(a, "市")(0) & "市"
        Arr(i, 4) = Split(a, "市")(1)
    ElseIf InStr(a, "區") Then
        Arr(i, 3) = Split(a, "區")(0) & "區"
        Arr(i, 4) = Split(a, "區")(1)
    End If
Next
Range("a1").Resize(UBound(Arr), 4) = Arr
End Sub

---

作者: aer    時間: 2021-11-18 10:22

回復 2# hcm19522

公式測試沒問題，感謝您！

---

作者: aer    時間: 2021-11-18 10:22

回復 3# samwang

測試沒問題，感謝您！

---

作者: 准提部林    時間: 2021-11-18 15:30

B2:
=LEFT(A2,3)

C2:
=MID(LEFT(A2,-LOOKUP(,-FIND({"鄉","鎮","市","區"},A2,4))),4,9)

D2:
=MID(A2,LEN(B2&C2)+1,99)

若地址規則不確定, 要另想辦法~~

---

作者: aer    時間: 2021-11-18 19:42

回復 6# 准提部林

測試沒問題，感謝您！

---

作者: ML089    時間: 2021-11-19 11:17

本帖最後由 ML089 於 2021-11-19 13:12 編輯

地址公式很難100%完全是對的
建議公式處理完還是要逐筆看看，才不會誤事。
尤其離島、山區的地址要格外小心。

上網查看110年行政區名與路名
縣市 3個字
鄉鎮市區 最多4個字
路名 最多9個字

---

作者: Andy2483    時間: 2023-11-20 13:04

謝謝論壇,謝謝各位前輩
後學藉此帖練習VBA陣列,請各位前輩指教

執行結果:
[attach]37058[/attach]


Option Explicit
Sub TEST()
Dim Brr, Pq, Pa, Q, i&, j%, N%, c%, Y&, T$
Range([B2], Cells(Rows.Count, 1).End(xlUp)(1, 4)).ClearContents
Brr = Range([D1], Cells(Rows.Count, 1).End(xlUp))
Q = [{"鄉","鎮","市","區"}]
For i = 2 To UBound(Brr)
   T = Brr(i, 1): Brr(i - 1, 1) = Left(T, 3): T = Mid(T, 4)
   For j = 1 To 4
      Pq = Split(T, Q(j))
      If UBound(Pq) > 0 Then c = j: N = N + 1: Pa = Pq
   Next
   If N = 1 Then
      Brr(i - 1, 2) = Pa(0) & Q(c)
      Brr(i - 1, 3) = Mid(T, Len(Pa(0)) + 2)
      Else: Y = Y + 1
   End If
   N = 0
Next
[B2].Resize(UBound(Brr) - 1, 3) = Brr
If Y > 0 Then MsgBox "有 " & Y & " 個無法辨別!"
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)