[已解决]字典、数组身份证重复计算

爱很简单

grf1973 发表于 2014-8-23 15:38
数据溢出估计是累计亩数太大了。你把brr，crr都定义成Double试试。

数据溢出的那个问题我解决了。谢谢您。

grf1973

这样更保险一点，前代码如果固定列的乡镇名数据库里没有会出错。

1. Private Sub CommandButton1_Click()
   
2.     Dim d As Object, arr, ori, i%, brr(1 To 1000, 4)
   
3.     Set d = CreateObject("scripting.dictionary")    '镇
   
4.     Set d1 = CreateObject("scripting.dictionary")   '身份证
   
5.     Set d2 = CreateObject("scripting.dictionary")   '大于10亩身份证
   
6.     With Sheets("数据库")
   
7.         ori = .Range("A4:u" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
   
8.     End With
   
9.     For i = 1 To UBound(ori)
   
10.         If ori(i, 1) <> "" Then
    
11.             sr = ori(i, 15)   '15数据库-镇
    
12.             sr1 = ori(i, 21) '21数据库-身份证
    
13.             ms = ori(i, 5) '亩数
    
14.             If Not d.exists(sr) Then
    
15.                 n = n + 1
    
16.                 d(sr) = n
    
17.               '  brr(n, 0) = sr
    
18.             End If
    
19.             k = d(sr)
    
20.             If Not d1.exists(sr1) Then brr(k, 1) = brr(k, 1) + 1: d1(sr1) = ""  '户数总计
    
21.             brr(k, 2) = brr(k, 2) + ms   '亩数总计
    
22.             If ms > 10 Then
    
23.                 brr(k, 4) = brr(k, 4) + ms    '大于10亩的亩数总计
    
24.                 If Not d2.exists(sr1) Then brr(k, 3) = brr(k, 3) + 1: d2(sr1) = ""  '大于10亩的户数总计
    
25.             End If
    
26.         End If
    
27.     Next
    
28.    With Sheets("汇总")
    
29.         crr = .Range("a6:e" & .[a65536].End(3).Row)
    
30.         For i = 1 To UBound(crr)
    
31.             sr = crr(i, 1)
    
32.             k = d(sr)
    
33.             If k > 0 Then
    
34.                 For j = 2 To 5
    
35.                     crr(i, j) = brr(k, j - 1)
    
36.                 Next
    
37.             End If
    
38.         Next
    
39.          .Range("a6:e" & .[a65536].End(3).Row) = crr
    
40.     End With
    
41. End Sub

复制代码

爱很简单

grf1973 发表于 2014-8-23 15:46
这样更保险一点，前代码如果固定列的乡镇名数据库里没有会出错。

在增加一个条件，怎么弄啊

grf1973

把镇名+村名作为字典的key就行了。

1. Sub tt()   
   
2.     Set d = CreateObject("scripting.dictionary")    '镇+村
   
3.     Set d1 = CreateObject("scripting.dictionary")   '身份证
   
4.     Set d2 = CreateObject("scripting.dictionary")   '大于10亩身份证
   
5.     With Sheets("数据库")
   
6.         ori = .Range("A4:u" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
   
7.     End With
   
8.    
   
9.     For i = 1 To UBound(ori)
   
10.         If ori(i, 1) <> "" Then
    
11.             sr = ori(i, 15) & ori(i, 16) '15+16：数据库-镇+村
    
12.             sr1 = ori(i, 21) '21数据库-身份证
    
13.             ms = ori(i, 5) '亩数
    
14.             If Not d.exists(sr) Then
    
15.                 n = n + 1
    
16.                 d(sr) = n
    
17.               '  brr(n, 0) = sr
    
18.             End If
    
19.             k = d(sr)
    
20.             If Not d1.exists(sr1) Then brr(k, 1) = brr(k, 1) + 1: d1(sr1) = ""  '户数总计
    
21.             brr(k, 2) = brr(k, 2) + ms   '亩数总计
    
22.             If ms > 10 Then
    
23.                 brr(k, 4) = brr(k, 4) + ms    '大于10亩的亩数总计
    
24.                 If Not d2.exists(sr1) Then brr(k, 3) = brr(k, 3) + 1: d2(sr1) = ""  '大于10亩的户数总计
    
25.             End If
    
26.         End If
    
27.     Next
    
28.    
    
29.    With Sheets("新问题")
    
30.         crr = .Range("a6:o" & .[a65536].End(3).Row)
    
31.         For i = 1 To UBound(crr)
    
32.             sr = crr(i, 1) & crr(i, 2)
    
33.             k = d(sr)
    
34. '            For j = 2 To 5
    
35. '                crr(i, j) = brr(k, j - 1)
    
36. '            Next
    
37.             crr(i, 3) = brr(k, 1): crr(i, 4) = brr(k, 2)
    
38.             crr(i, 14) = brr(k, 3): crr(i, 15) = brr(k, 4)
    
39.         Next
    
40.          .Range("a6:o" & .[a65536].End(3).Row) = crr
    
41.     End With
    
42. End Sub

复制代码

雄鹰2013

学习下