12
返回列表 上一主題 發帖

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

owen9399

帖子
94 
主題
16 
精華
0 
積分
128 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-1-30 
最後登錄
2015-11-17 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-2-6 10:10 | 只看該作者

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

本帖最後由 owen9399 於 2012-2-9 15:49 編輯



如何寫 函數 或 vba

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

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

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

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

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

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

彰化縣鹿港鎮放一起

彰化縣溪湖鎮放一起

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




謝謝大大


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



地址範本:

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



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

地址分類.rar (3.47 KB)

收藏 分享
owen

owen9399

帖子
94 
主題
16 
精華
0 
積分
128 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-1-30 
最後登錄
2015-11-17 
2#
發表於 2012-2-7 00:08 | 只看該作者
我目前 有用  字串 來取代

但有一些問題
owen

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
44  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2012-2-7 00:54 | 只看該作者
本帖最後由 Hsieh 於 2012-2-7 01:23 編輯

回復 2# owen9399
可製作一個分類表
再以分類表為標準來分類如圖
  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
複製代碼
學海無涯_不恥下問

TOP

owen9399

帖子
94 
主題
16 
精華
0 
積分
128 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-1-30 
最後登錄
2015-11-17 
4#
發表於 2012-2-7 11:41 | 只看該作者
本帖最後由 owen9399 於 2012-2-7 12:53 編輯

請問  超級版主 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)      

地址分類測試修正版.rar (27.16 KB)
謝謝大大的指導   


彰化市 放一起

花壇鄉        秀水鄉        埔鹽鄉        溪湖鎮  的放一起   
但是    空一格
例如:   
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**號



　　　　　　　　　　　　
owen

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
44  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 2012-2-7 15:25 | 只看該作者
本帖最後由 Hsieh 於 2012-2-7 15:29 編輯

回復 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
複製代碼
學海無涯_不恥下問

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2012-2-7 16:15 | 只看該作者
回復 4# owen9399
字串的替換
  1. Sub 按鈕3_Click()
  2.     Range("E2:E65536").Replace What:="*彰化市*鄰", Replacement:="彰化市", LookAt:=xlPart
  3. End Sub
複製代碼

TOP

owen9399

帖子
94 
主題
16 
精華
0 
積分
128 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-1-30 
最後登錄
2015-11-17 
7#
發表於 2012-2-8 11:11 | 只看該作者
謝謝各位大大的 講解與分享
owen

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
44  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-2-20 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2012-2-8 19:27 | 只看該作者
回復 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) '去除郵遞區號

  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)
學海無涯_不恥下問

TOP

owen9399

帖子
94 
主題
16 
精華
0 
積分
128 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-1-30 
最後登錄
2015-11-17 
9#
發表於 2012-2-9 10:40 | 只看該作者
本帖最後由 owen9399 於 2012-2-9 10:42 編輯

謝謝 大大的提供  

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

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

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
10#
發表於 2012-2-9 10:50 | 只看該作者
回復 9# owen9399

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

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

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

TOP

        靜思自在 : 並非有錢魷是快樂，問心無愧心最安。
12
返回列表 上一主題