[發問] 想請教有關住址轉換的問題

kuhsuanchieh

因為在請每個人填寫（輸入）住址的時候，大家的寫法都會有一些不一樣，例如有人會寫鄰里，有人喜歡用阿拉伯數字（還分全、半型），有人喜歡寫國字小寫（例如：一、二、三），樓層有的寫"樓"有的寫"F"，之幾號有的用"之"有的用蚯蚓（~）還有大小隻，看到都快昏倒。

相請問各位，在VBA的程式中有沒有甚麼方法可以將住址給統一？
也就是不論住址為何，我想要讓縣市出現在A欄位、鄉鎮市區出現在B欄位、鄰里不要出現、路含以下都出現在C欄位，路段及樓層全部改為國字小寫（例如：一、二、三.......九、十），且不管寫"F"還是"Ｆ"都改成"樓"這個字，中間巷、弄、號的數字為阿拉伯數字全型，大小蚯蚓（）都變成"之"

例如：
台北市中正區八德路１段１５０５號３Ｆ　　　                  →　　台北市      中正區      八德路一段１５０之５號三樓
台北市中正區八德路一段150~5號３Ｆ　　　                         →         台北市      中正區      八德路一段１５０之５號三樓
台北市中正區東門里003鄰林森南路四十三之一號                  →         台北市      中正區      林森南路４３之１號
台北市中正區東門里3鄰林森南路43~1號3樓                           →         台北市      中正區      林森南路４３之１號

kuhsuanchieh

因為在請每個人填寫（輸入）住址的時候，大家的寫法都會有一些不一樣，例如有人會寫鄰里，有人喜歡用阿拉伯 ...
kuhsuanchieh 發表於 2015-7-16 15:51

補上範例檔案



住址格式統一.rar (185.56 KB)

範例檔案
下載次數: 10

2015-7-18 23:04

GBKEE

回復 2# kuhsuanchieh
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, A As Variant, Ar(), e As Variant, Ay(), i As Integer, x_Er As String
   
4.     Ar = Array("市", "縣", "區", "鄉", "鎮") '行政區
   
5.     Set Rng = Sheets("工作表1").[A2]
   
6.     Do While Rng <> ""
   
7.         i = i + 1
   
8.         A = Rng.Text
   
9.         A = Replace(A, "F", "樓")
   
10.         A = Replace(A, "f", "樓")
    
11.         For Each e In Ar
    
12.             A = Replace(A, e, e & ",")
    
13.         Next
    
14.         A = Split(A, ",")
    
15.         ReDim Preserve Ay(1 To i)
    
16.         If UBound(A) = 2 Then
    
17.             For Each e In Array("村", "里", "鄰", "?") '鄰 耳有左,有右
    
18.                 A(2) = Replace(A(2), e, e & ",")
    
19.             Next
    
20.             If InStr(A(2), ",") Then
    
21.                 A(2) = Split(A(2), ",")(UBound(Split(A(2), ",")))
    
22.             End If
    
23.             A(2) = Ex_國字轉數字(A(2) & "")
    
24.             '國字轉數字可自己GOOGLE練習一下
    
25.             Ay(i) = A
    
26.         Else
    
27.             Ay(i) = Array("", "", "")
    
28.             x_Er = x_Er & "," & Rng.Address(0, 0)
    
29.         End If
    
30.         Set Rng = Rng.Offset(1)
    
31.     Loop
    
32.      Rng.Parent.[b2].Resize(i, 3) = Application.Transpose(Application.Transpose(Ay))  '
    
33.      If x_Er <> "" Then MsgBox Mid(x_Er, 2), Title:="住址需用手工修正"
    
34. End Sub
    
35. Function Ex_國字轉數字(x_Word As String) As String
    
36.     Ex_國字轉數字 = x_Word
    
37. End Function

複製代碼

kuhsuanchieh

回復  kuhsuanchieh
試試看
GBKEE 發表於 2015-7-19 10:29

謝謝你，雖然還是有點不瞭解！

sillykin

回復 3# GBKEE


    不好意思,,能否請教
路、段、巷、弄、號、樓
全部分開放入每一個儲存格,,,要如何製作呢????