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

爱很简单

字典+数组身份证重复计算

最佳答案

月排行榜 / 总排行榜

grf1973

2014-8-23 15:36

乡镇固定列的代码。

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.             For j = 2 To 5
    
34.                 crr(i, j) = brr(k, j - 1)
    
35.             Next
    
36.         Next
    
37.          .Range("a6:e" & .[a65536].End(3).Row) = crr
    
38.     End With
    
39. End Sub

复制代码

跳转到最佳答案楼层

grf1973

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

复制代码

grf1973

。。。。。。。。。。。。。。。。

su45

l嗯，楼上的应该合题了！

爱很简单

grf1973 发表于 2014-8-22 17:08
。。。。。。。。。。。。。。。。

好人啊，谢谢您，我还有个小小的请求，就是汇总表中乡镇那一列是固定的，而不是从数据库中取得的，能实现吗，大概有个乡镇那样子。谢谢您

爱很简单

grf1973 发表于 2014-8-22 17:08
。。。。。。。。。。。。。。。。

还有个小小请求，数据量大的时候会出现溢出错误。还有就是乡镇那一列是固定的，差不多23个，而不是从数据库中取得，
xie

爱很简单

grf1973 发表于 2014-8-22 17:06

数据库中的数据超过3.5万行就会出现溢出错误！！！！

爱很简单

·····

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.             For j = 2 To 5
    
34.                 crr(i, j) = brr(k, j - 1)
    
35.             Next
    
36.         Next
    
37.          .Range("a6:e" & .[a65536].End(3).Row) = crr
    
38.     End With
    
39. End Sub

复制代码

grf1973

数据溢出估计是累计亩数太大了。你把brr，crr都定义成Double试试。