[發問] [已解決]如何地址分類

owen9399

下載 (251.59 KB)

2012-2-6 10:04

如何寫 函數 或 vba

自動分類資料:
把資料貼上 sheet1 的表單  , 新增按鈕 (地址自動分類)
儲存於 sheet2的表單

1.其中 舊資料中的 彰化縣彰化市田中里２４鄰彰泰二街２８之１１號　
變成 新資料   彰化市彰泰二街２８之１１號

去除   彰化縣 田中里 24鄰 保留  彰化市
但是   保留   彰化縣和美鎮 ...彰化縣鹿港鎮 ....等   外縣鄉鎮

2.
自動排列  QTY的數值  由  大排到小  

3.分區域儲存 資料於 sheet2 的表
彰化市的 放一起

彰化縣芬園鄉+彰化縣和美鎮+彰化縣線西鄉  放一起

彰化縣鹿港鎮放一起

彰化縣溪湖鎮放一起

各區  空格距離(間距)10列

下載 (236.35 KB)

2012-2-6 10:06

謝謝大大


另外 sheet2的表單
zip的數字 就不要顯示出來 可以自動刪除



地址範本:

彰化縣溪湖鎮中山里２０鄰大溪路一段７０３號　　　　　　　　　
彰化縣芬園鄉圳墘村４鄰彰南路一段８４５號　　　　　　　　　　
彰化市西興里景宗街６６巷２１號　　　　　　　　　　　　　　　
彰化縣鹿港鎮溝墘里６鄰溝墘巷２０８號　　　　　　　　　　　　
彰化縣鹿港鎮新宮里７鄰文開路６巷２１號　　　　　　　　　　　
彰化縣鹿港鎮景福里９鄰景福巷１１１號　　　　　　　　　　　　
彰化縣溪湖鎮中山里３鄰大溪路１段４９４號　　　　　　　　　　
彰化縣溪湖鎮東溪里２鄰銀錠路２３２巷７４弄３號　　　　　　　
彰化縣溪湖鎮中山里３鄰大溪路１段４９４號　　　　　　　　　　



彰化市中正路二段９４號　　　　　　　　　　　　　　　　　　　
彰化縣線西鄉頂犁村１１鄰頂犁路１２３號　　　　　　　　　　　
彰化縣芬園鄉圳墘村１０鄰碧園路一段３５５巷５號　　　　　　　
彰化縣彰化市下

owen9399

我目前 有用  字串 來取代

但有一些問題

Hsieh

回復 2# owen9399
可製作一個分類表
再以分類表為標準來分類如圖

下載 (51.27 KB)

2012-2-7 01:23

1. Sub nn()
   
2. Dim Ar(2), Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheets("Sheet1")
   
5. Ar(0) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[D1].Value, .[E1].Value)
   
6. For Each a In .Range("E2", .[E65536].End(xlUp))
   
7. i = IIf(InStr(a, "縣") > 0, 4, 1)
   
8.    mystr = Mid(a, i, 3)
   
9.    Set B = .Columns("I:K").Find(mystr, lookat:=xlWhole)
   
10.    If B Is Nothing Then
    
11.       ky = 5
    
12.    Else
    
13.       ky = .Cells(B.Row, "H").Value
    
14.    End If
    
15.    If IsEmpty(d(ky)) Then
    
16.       Ar(1) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
    
17.       d(ky) = Ar
    
18.       Else
    
19.       Ay = d(ky)
    
20.       s = UBound(Ay)
    
21.       ReDim Preserve Ay(s + 1)
    
22.       Ay(s) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
    
23.       d(ky) = Ay
    
24.       Erase Ay
    
25.     End If
    
26. Next
    
27. End With
    
28. With Sheets("Sheet2")
    
29. .[A:F] = ""
    
30. r = 1
    
31. For Each ky In d.keys
    
32.    For i = LBound(d(ky)) To UBound(d(ky))
    
33.       .Cells(r, "A").Resize(, 5) = d(ky)(i)
    
34.       r = r + 1
    
35.    Next
    
36. Next
    
37. End With
    
38. End Sub

複製代碼

owen9399

請問  超級版主 Hsieh 或 各位大大
1.可以修改   以此順序 排列
H        I        J        K        L
分組               鄉鎮市區
1           彰化市       
2           花壇鄉        秀水鄉        埔鹽鄉        溪湖鎮
3           鹿港鎮        福興鄉
4           線西鄉        伸港鄉        和美鎮        芬園鄉
       
       
2.設定  每頁的大小  固定    列印範圍  版面設定    上.下.左.右:  各為1cm

3.設定 分頁      如 分組1   為一頁
A_NO        A_NM        QTY        TEL            ADDR
32848        羅**　　265000        04-75***            彰化市西興里景宗街**巷２*號　

另外  請問  
我有新增 彰化市 的  (例如:500 . 彰化縣 . 彰化縣彰化市　. 0001里 . 13鄰...等 )  用字串 表示 取代 或 不顯示  ,但是 有些問題   ,
       如:   500彰化縣彰化市延平里15鄰中山路1段509號    按下 修改按鈕
        顯示       彰化市1中山路1段509號   (15鄰的  1 未被取代  成不顯示)  

另外 附上     完整的清單的結果  +  如何修正檔的資料表
地址分類測試清單版.rar (27.51 KB)

下載次數: 6

2012-2-7 12:37

     

地址分類測試修正版.rar (27.16 KB)

下載次數: 7

2012-2-7 12:37

謝謝大大的指導   


彰化市 放一起

花壇鄉        秀水鄉        埔鹽鄉        溪湖鎮  的放一起   
但是    空一格
例如:   
A_NO        A_NM        QTY        TEL            ADDR
32848        羅**　　265000        04-75***            彰化縣花壇鄉景宗街**巷２*號　

A_NO        A_NM        QTY        TEL            ADDR
328        林**　　26000        04-75***            彰化縣秀水鄉溪心街**巷1２*號
3268        王**　　20230        04-75***            彰化縣秀水鄉溪心街10**號



　　　　　　　　　　　　

Hsieh

回復 4# owen9399
鄉鎮市區做分類不是嗎?

1. Sub Ex()
   
2. Dim Mystr$, Ar(2), Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheets("Sheet1")
   
5. Ar(0) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[D1].Value, .[E1].Value)
   
6. For Each a In .Range("E2", .[E65536].End(xlUp))
   
7.   i = IIf(InStr(a, "縣") > 0, 4, 1) + IIf(Val(a) > 0, Len(CStr(Val(a))), 0) '判斷鄉鎮市區的起始位置
   
8.   Mystr = Mid(a, i, 3) '鄉鎮市區
   
9.   If IsEmpty(d(Mystr)) Then
   
10.      Ar(1) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
    
11.      d(Mystr) = Ar '以鄉鎮市區做索引加入內容
    
12.      Else
    
13.      Ay = d(Mystr)
    
14.      s = UBound(Ay)
    
15.      ReDim Preserve Ay(s + 1)
    
16.      Ay(s) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
    
17.      d(Mystr) = Ay '以鄉鎮市區做索引加入內容
    
18.   End If
    
19. Next
    
20. End With
    
21. With Sheets("Sheet2")
    
22. .PageSetup.PrintArea = "$A:$E" '列印範圍
    
23. .ResetAllPageBreaks '重設分頁線
    
24. .Cells = ""
    
25. r = 1
    
26. For Each ky In d.keys
    
27.    For i = LBound(d(ky)) To UBound(d(ky))
    
28.       .Cells(r, 1).Resize(, 5) = d(ky)(i) '寫入
    
29.       r = r + 1
    
30.    Next
    
31.    .HPageBreaks.Add .Cells(r, "A") '增加分頁
    
32. Next
    
33. End With
    
34. End Sub

複製代碼

GBKEE

回復 4# owen9399
字串的替換

1. Sub 按鈕3_Click()
   
2.     Range("E2:E65536").Replace What:="*彰化市*鄰", Replacement:="彰化市", LookAt:=xlPart
   
3. End Sub

複製代碼

owen9399

謝謝各位大大的 講解與分享

Hsieh

回復 7# owen9399
樓主的資料並不包含直轄市地址格式
以下程式碼可判斷直轄市
並取得鄉、鎮、市、區的名稱做分類
請各位想想是否有更有效率且適用性更廣的方式

1. Sub ex()
   
2. Dim Ay(2), Ary()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. ar = Array("鄉", "鎮", "市", "區")
   
5. With Sheets("Sheet1")
   
6. Ay(0) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[D1].Value, .[E1].Value)
   
7. For Each a In .Range("E2", .[E65536].End(xlUp))
   
8. For i = 0 To 3
   
9.   If k < InStr(a, ar(i)) Then k = InStr(a, ar(i)): b = Mid(a, k, 1)
   
10. Next
    
11. '取得鄉鎮市區字串
    
12. mystr = Mid(a, 1, k):   k = 0
    
13. If InStr(mystr, "縣") > 0 Then mystr = Mid(mystr, InStr(mystr, "縣") + 1) '去除縣名
    
14. If InStr(mystr, "市") > 0 And InStr(mystr, "區") > 0 Then mystr = Mid(mystr, InStr(mystr, "市") + 1) '去除直轄市
    
15. If Val(mystr) > 0 Then mystr = Mid(mystr, Len(CStr(Val(mystr))) + 1) '去除郵遞區號
    
16. 
    
17. If IsEmpty(d(mystr)) Then '以未出現過的鄉鎮市區字串作為索引加入內容
    
18.    Ay(1) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
    
19.    d(mystr) = Ay
    
20.    Else '以出現過的鄉鎮市區字串作為索引加入內容
    
21.    Ary = d(mystr) '取出陣列
    
22.    s = UBound(Ary)
    
23.    ReDim Preserve Ary(s + 1) '擴大陣列
    
24.    Ary(s) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
    
25.    d(mystr) = Ary '寫回鄉鎮市區字串作為索引的內容
    
26. End If
    
27. Next
    
28. End With
    
29. With Sheets("Sheet2")
    
30. .Cells = ""
    
31. r = 1
    
32. For Each ky In d.keys '以鄉鎮市區分類的迴圈
    
33.   For i = LBound(d(mystr)) To UBound(d(ky))
    
34.    .Cells(r, 1).Resize(, 5) = d(ky)(i) '寫入
    
35.    r = r + 1
    
36.   Next
    
37. Next
    
38. End With
    
39. End Sub

複製代碼

地址分類.rar (14.04 KB)

下載次數: 5

2012-2-8 19:27

owen9399

謝謝 大大的提供  

想請問 如何固定   A1~E1的欄寬
例如:    A1欄寬為8  , B1欄寬為9  ,C1欄寬為10  ,  D1欄寬為10    ,E1 欄寬為 50

就算 從別的B資料 複製  ,貼上 其欄位也保持不變

register313

回復 9# owen9399

選A欄位標籤, 格式/欄/欄寬 ,輸入8
....   

欄寬本來就是固定的,除非自己去改變它,所以應不需要用VBA去設定欄寬

VBA語法
Columns("A:A").ColumnWidth =8