[已解决]用VBA解决数据提取和分类统计的，人都等发霉了，有没老师、大神帮下忙啊

hui3643616

用VBA匹配另二张表，返回那二张表的相关数据，然后分类统计，生成一张或多张表
求高手帮帮忙，谢谢！
附件里面有详细的说明和步骤（先前附件说的还有点不明白，我又重新作了补充，也做了个样式，样式表的数据是准确的，不是瞎编的，在另外2张表都用相同的颜色标记出来了）

最佳答案

月排行榜 / 总排行榜

grf1973

2017-8-31 15:18

重新做了个字典的。和数据库的结果一致。
数据库代码中  union all 需改为 union，原因是“查实”表中有相同记录。

1. Sub 字典()
   
2.     Set reg = CreateObject("vbscript.regexp")
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     reg.Global = True
   
6.     reg.Pattern = "(高血压|糖尿病|老年人|精神病|结核病)"
   
7.     brr = Sheets("查实").[a1].CurrentRegion
   
8.     For i = 2 To UBound(brr): d1(brr(i, 3)) = "": Next
   
9.     Dim arr(1 To 10000, 1 To 7)
   
10.     For k = 1 To 2
    
11.         brr = Sheets(k).[a1].CurrentRegion
    
12.         For i = 2 To UBound(brr)
    
13.             If d1.exists(brr(i, 2)) Then
    
14.                 n = n + 1
    
15.                 x = brr(i, 7): bz = ""
    
16.                 Set ma = reg.Execute(x)
    
17.                 For Each m In ma
    
18.                     d(brr(i, 1) & "-" & m) = d(brr(i, 1) & "-" & m) + 1
    
19.                     bz = bz & "," & m
    
20.                 Next
    
21.                 arr(n, 7) = Mid(bz, 2)
    
22.                 For j = 1 To 6
    
23.                     arr(n, j) = brr(i, j)
    
24.                 Next
    
25.             End If
    
26.         Next
    
27.     Next
    
28.    
    
29.     With Sheets("匹配")
    
30.         .Cells.ClearContents
    
31.         .[a1].Resize(1, 7) = Array("乡镇街道", "身份证号", "姓名", "地址", "线索类型", "领取时间", "备注")
    
32.         .[L1].Resize(1, 2) = Array("乡镇街道-疾病类型", "出现次数")
    
33.         .[a2].Resize(n, UBound(arr, 2)) = arr
    
34.         .[L2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
35.         .[a2].Resize(n, UBound(arr, 2)).Sort key1:=.[a2], key2:=.[b2]
    
36.         .[L2].Resize(d.Count, 2).Sort key1:=.[L2]
    
37.     End With
    
38. End Sub
    

复制代码

跳转到最佳答案楼层

idnoidno

不好意思，我看了半天(包括您的第一一次帖子)，查表的A~F都沒有高血压、糖尿病、老年人、精神病和領取時間和備註的欄位耶
如果只是拆紛表的話，小弟可以出點力喔

hui3643616

不是拆表，說穿了就是用查實那張表的身份證或姓名去匹配未查到和不一致那二張表的身份證和姓名然後用vlookup函數返回所要的列，組成一個新的表格，再統計這張新錶裡面的各種病情的次數，最後以鄉鎮分別生成一張表或是在一張表都可以
這主要就是那個未查到那張表裡面的備註次數不好統計，一個單元格裡面一個病情出現幾次就要統計幾次，不是作為一次處理。

idnoidno

您的ˋ意思是結果就是查表的黃色的區域的範例嗎?

hui3643616

對的，黃色區域部分就是以一個鄉鎮為例子的，最後結果就是這樣的那個綠色部分也要看，因為有幾十個鄉鎮，就是那個樣板，綠色部分就是下一個鄉鎮，不過數據我就沒填

today0427

已经发霉了？再等等，等长蘑菇了我来摘蘑菇

grf1973

这种简单的事情 我来吧。来个大杂烩，用到ado，字典，正则。
其实只用字典足矣。

hui3643616

grf1973 发表于 2017-8-31 10:08
这种简单的事情 我来吧。来个大杂烩，用到ado，字典，正则。
其实只用字典足矣。

表格里面没代码阿？

grf1973

呵呵，发错附件了。

hui3643616

grf1973 发表于 2017-8-31 10:28
呵呵，发错附件了。

这是什么意思