[原創] 3+2郵遞區號查詢

lpk187

最近閒來無事，學習字典的用法。而寫了這個程式，剛好公司也有用到，分享給各位！
也請各位大大給予指教
3+2碼郵遞區號查詢.rar (775.01 KB)

下載次數: 45

2015-6-3 17:42

GBKEE

回復 1# lpk187
執行表單各縣市的行政區如有相同名稱,投遞街道會有錯誤.
我住基隆一眼看出中山區沒有 一江街. 中正區沒有汀洲路3段

下載 (61.24 KB)

2015-6-4 17:24

下載 (65.49 KB)

2015-6-4 17:24

幫你修改一下

1. Dim Sh As Worksheet, d As Object, d2 As Object, d3 As Object
   
2. Private Sub UserForm_Initialize()
   
3.     Dim i As Single, Rng As Range
   
4.     Set Sh = Sheets("3+2郵遞區號檔")
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     Set Rng = Sh.Cells(2, "b")
   
7.     Do While Rng <> ""
   
8.         If d.exists(Rng.Value) = False Then
   
9.             Set d(Rng.Value) = Rng
   
10.         Else
    
11.             Set d(Rng.Value) = Union(Rng, d(Rng.Value))
    
12.         End If
    
13.         Set Rng = Rng.Offset(1)
    
14.     Loop
    
15.     ComboBox1.List = d.KEYS
    
16.     TextBox1 = ""
    
17. End Sub
    
18. Private Sub ComboBox1_Change()
    
19.     Dim R As Range
    
20.     TextBox1 = ""
    
21.     Set d2 = CreateObject("scripting.dictionary")
    
22.     For Each R In d(ComboBox1.Value).Offset(, 1).Cells
    
23.         If d2.exists(R.Value) = False Then
    
24.             Set d2(R.Value) = R
    
25.         Else
    
26.             Set d2(R.Value) = Union(R, d2(R.Value))
    
27.         End If
    
28.     Next
    
29.     ComboBox2.Clear
    
30.     ComboBox2.List = d2.KEYS
    
31. End Sub
    
32. 
    
33. Private Sub ComboBox2_Change()
    
34.     Dim R As Range
    
35.     TextBox1 = ""
    
36.     ComboBox3.Clear
    
37.     Set d3 = CreateObject("scripting.dictionary")
    
38.     If ComboBox2.ListIndex > -1 Then
    
39.         For Each R In d2(ComboBox2.Value).Offset(, 1).Cells
    
40.             If d3.exists(R.Value) = False Then
    
41.                 Set d3(R.Value) = R
    
42.             Else
    
43.                 Set d3(R.Value) = Union(R, d3(R.Value))
    
44.             End If
    
45.         Next
    
46.         ComboBox3.List = d3.KEYS
    
47.     End If
    
48. End Sub
    
49. Private Sub ComboBox3_Change()
    
50.     TextBox1 = ""
    
51.     If ComboBox3.ListIndex > -1 Then TextBox1.Text = Sh.Cells(d3(ComboBox3.Value).Row, "A")
    
52.     'ListIndex = -1 值不在List中
    
53. End Sub
    
54. Private Sub CommandButton1_Click()
    
55.     Dim Rng As Range
    
56.     If ComboBox3.ListIndex = -1 Then Exit Sub
    
57.     With Sheets("工作表1")
    
58.         Set Rng = .Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
    
59.     End With
    
60.     With Rng
    
61.         .Cells = TextBox1.Text
    
62.         .Cells(1, "b") = ComboBox1.Value
    
63.         .Cells(1, "c") = ComboBox2.Value
    
64.         .Cells(1, "d") = ComboBox3.Value
    
65.         .Cells(1, "e") = d3(ComboBox3.Value).Cells(1, "b")
    
66.     End With
    
67. End Sub

複製代碼

lpk187

回復 2# GBKEE


    感謝版大的修正！謝謝！