- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
3#
發表於 2015-7-19 10:29
| 只看該作者
回復 2# kuhsuanchieh
試試看- Option Explicit
- Sub Ex()
- Dim Rng As Range, A As Variant, Ar(), e As Variant, Ay(), i As Integer, x_Er As String
- Ar = Array("市", "縣", "區", "鄉", "鎮") '行政區
- Set Rng = Sheets("工作表1").[A2]
- Do While Rng <> ""
- i = i + 1
- A = Rng.Text
- A = Replace(A, "F", "樓")
- A = Replace(A, "f", "樓")
- For Each e In Ar
- A = Replace(A, e, e & ",")
- Next
- A = Split(A, ",")
- ReDim Preserve Ay(1 To i)
- If UBound(A) = 2 Then
- For Each e In Array("村", "里", "鄰", "?") '鄰 耳有左,有右
- A(2) = Replace(A(2), e, e & ",")
- Next
- If InStr(A(2), ",") Then
- A(2) = Split(A(2), ",")(UBound(Split(A(2), ",")))
- End If
- A(2) = Ex_國字轉數字(A(2) & "")
- '國字轉數字可自己GOOGLE練習一下
- Ay(i) = A
- Else
- Ay(i) = Array("", "", "")
- x_Er = x_Er & "," & Rng.Address(0, 0)
- End If
- Set Rng = Rng.Offset(1)
- Loop
- Rng.Parent.[b2].Resize(i, 3) = Application.Transpose(Application.Transpose(Ay)) '
- If x_Er <> "" Then MsgBox Mid(x_Er, 2), Title:="住址需用手工修正"
- End Sub
- Function Ex_國字轉數字(x_Word As String) As String
- Ex_國字轉數字 = x_Word
- End Function
|
|
發表於 2015-7-16 15:51
| 
