求大神帮我做一个宏，以达到省市区的自动匹配

蓝桥玄霜 · 发表于 2015-4-4 14:30

请见附件。

huang1314wei · 发表于 2015-4-4 19:47

蓝桥玄霜发表于 2015-4-4 14:30
请见附件。

有一点问题，生成的市和区有重复情况出现

huang1314wei · 发表于 2015-4-4 19:48

jpj123 发表于 2015-4-4 13:46
修改了代码，详见附件

谢谢，比较完美哦

chenbiao2012 · 发表于 2015-4-4 20:53

本帖最后由 chenbiao2012 于 2015-4-4 20:59 编辑

Sub test()
Set d = CreateObject("scripting.dictionary")
With Sheets("A")
arr = .[a1].CurrentRegion
For i = 1 To UBound(arr)
d(arr(i, 1) & arr(i, 3)) = Array(arr(i, 1), arr(i, 2), arr(i, 3))
Next
End With
With Sheets("B")
arr = .UsedRange
For i = 1 To UBound(arr)
For Each kk In d.keys
If InStr(kk, arr(i, 1)) > 0 And InStr(kk, arr(i, 3)) > 0 Then
For j = 1 To 3
arr(i, j) = d(kk)(j - 1)
Next
End If
Next
Next
.[a1].Resize(UBound(arr), 3) = arr
End With
End Sub

复制代码

chenbiao2012 · 发表于 2015-4-4 20:57

解决这个用不着字典，单用数组就可以了，想复杂了

chenbiao2012 · 发表于 2015-4-4 21:06

Sub test()
With Sheets("A")
arr = .[a1].CurrentRegion
End With
With Sheets("B")
brr = .UsedRange
For j = 1 To UBound(brr)
For i = 1 To UBound(arr)
If InStr(arr(i, 1), brr(j, 1)) > 0 And InStr(arr(i, 3), brr(j, 3)) > 0 Then
For m = 1 To 3
brr(j, m) = arr(i, m)
Next
End If
Next
Next
.[a1].Resize(UBound(brr), 3) = brr
End With
End Sub

复制代码

huang1314wei · 发表于 2015-4-10 08:40

chenbiao2012 发表于 2015-4-4 21:06

非常完美，效率很高，谢谢

yjh_27 · 发表于 2015-4-10 13:27

如何根据县市区匹配所在省市县区
http://club.excelhome.net/thread-1070539-1-1.html

huang1314wei · 发表于 2015-4-10 17:44

yjh_27 发表于 2015-4-10 13:27
如何根据县市区匹配所在省市县区
http://club.excelhome.net/thread-1070539-1-1.html

大神，看了你的这个贴子，你的代码太赞了，由于我的VBA基本是0基础，http://club.excelhome.net/thread-1070539-1-1.html这个贴子里面提问者的省市区规则跟我的这个规则不太一样，你的代码我尝试修改了好长时间，但是调试总是不成功，希望大神能抽出时间帮我做个代码，能达到我的目的就好了，具体要求已经写在附件表格里面了

匹配省市区县.rar (85.19 KB, 下载次数: 54)

yjh_27 · 发表于 2015-4-10 19:14

huang1314wei 发表于 2015-4-10 17:44
大神，看了你的这个贴子，你的代码太赞了，由于我的VBA基本是0基础，http://club.excelhome.net/thread- ...

参见附件。

		自动登录	找回密码
密码			免费注册

[已解决] 求大神帮我做一个宏，以达到省市区的自动匹配