[已解决]求助：由两个数据源的统计

gmshe58

求助老师帮忙：由两个数据源的统计。谢谢。 20111229.rar (10.21 KB, 下载次数: 15)

2011-12-29 20:28 上传

点击文件名下载附件
我增加了一个过渡表。附件在2楼。都是统计次数的。

最佳答案

月排行榜 / 总排行榜

liuguansky

2011-12-30 11:57

1. 
   
2. Public d As New Dictionary, Mr&
   
3. Sub j()
   
4.     Dim Arr, i&, Ar, Rng As Range
   
5.     Dim j As Byte, s$, arrt()
   
6.     With Worksheets("数源1")
   
7.         Arr = .Range("d9:g" & .Range("d9").End(4).Row).Value
   
8.     End With
   
9.     Ar = Array("迟到", "早退", "请假", "外出", "上班漏刷", "下班漏刷")
   
10.     d.RemoveAll
    
11.     For i = 0 To UBound(Ar)
    
12.         d.Add Ar(i), IIf(i > 4, 4, i)
    
13.     Next
    
14.     For i = 1 To UBound(Arr)
    
15.         If d.Exists(Arr(i, 1)) Then
    
16.             Ar = d(Arr(i, 1))
    
17.             Ar(d(Arr(i, 4))) = Ar(d(Arr(i, 4))) + 1
    
18.             d(Arr(i, 1)) = Ar
    
19.         Else
    
20.             Ar = Array(0, 0, 0, 0, 0)
    
21.             Ar(d(Arr(i, 4))) = Ar(d(Arr(i, 4))) + 1
    
22.             d(Arr(i, 1)) = Ar
    
23.         End If
    
24.     Next i
    
25.     With Worksheets("数源2")
    
26.         Arr = .Range(.[a3], .[e3].End(4)).Value
    
27.         s = "外出"
    
28.         For i = 1 To UBound(Arr)
    
29.             If Arr(i, 5) Like "*私事*" Then
    
30.                 If d.Exists(Arr(i, 1)) Then
    
31.                     Ar = d(Arr(i, 1))
    
32.                     Ar(d(s)) = Ar(d(s)) + 1
    
33.                     d(Arr(i, 1)) = Ar
    
34.                 Else
    
35.                     Ar = Array(0, 0, 0, 0, 0)
    
36.                     Ar(d(s)) = Ar(d(s)) + 1
    
37.                     d(Arr(i, 1)) = Ar
    
38.                 End If
    
39.             End If
    
40.         Next
    
41.         Set Rng = .Cells.Find("请假、 记事")
    
42.         If Not Rng Is Nothing Then
    
43.             Arr = .Range(.Cells(Rng.Row + 1, 1), .Cells(Rng.Row + 1, 5).End(4)).Value
    
44.             s = "请假"
    
45.             For i = 1 To UBound(Arr)
    
46.                 If Arr(i, 5) Like "*私事*" Then
    
47.                     If d.Exists(Arr(i, 1)) Then
    
48.                         Ar = d(Arr(i, 1))
    
49.                         Ar(d(s)) = Ar(d(s)) + 1
    
50.                         d(Arr(i, 1)) = Ar
    
51.                     Else
    
52.                         Ar = Array(0, 0, 0, 0, 0)
    
53.                         Ar(d(s)) = Ar(d(s)) + 1
    
54.                         d(Arr(i, 1)) = Ar
    
55.                     End If
    
56.                 End If
    
57.             Next
    
58.         End If
    
59.     End With
    
60.     With Worksheets("统计")
    
61.         Mr = .Cells.Find("说明：", lookat:=xlPart).Row - 3
    
62.         Call Fh(.Range("a3"))
    
63.         Call Fh(.Range("i3"))
    
64.         Call Fh(.Range("q3"))
    
65.         Call Fh(.Range("y3"))
    
66.         Call Fh(.Range("ag3"))
    
67.     End With
    
68. End Sub
    
69. Sub Fh(Rng As Range)
    
70.     Dim arrt(), i&, j As Byte
    
71.     Arr = Worksheets("统计").Range(Rng, Rng.End(4)).Value
    
72.     ReDim arrt(1 To UBound(Arr), 1 To 6)
    
73.     For i = 1 To UBound(Arr)
    
74.         If d.Exists(Arr(i, 1)) Then
    
75.             Ar = d(Arr(i, 1))
    
76.             For j = 0 To 4
    
77.                 arrt(i, j + 2) = Ar(j)
    
78.             Next j
    
79.             arrt(i, 1) = (arrt(i, 2) + arrt(i, 3) + arrt(i, 6)) * 0.5
    
80.         End If
    
81.     Next i
    
82.     Rng.Offset(0, 2).Resize(Mr, 6).ClearContents
    
83.     Rng.Offset(0, 2).Resize(UBound(arrt), 6) = arrt
    
84. End Sub
    

复制代码

已修正
有冻结窗口。最后表的说明没注意看，不好意思
20111229.rar (26.17 KB, 下载次数: 19)

2011-12-30 12:02 上传

点击文件名下载附件

跳转到最佳答案楼层

gmshe58

这个求助太难了吗？我增加一个过渡表，估计用函数、数组就可以解决了。都是统计次数的。我还是想用VBA解决。
函数、数组也能加按钮吗？ 20111229b.rar (11.69 KB, 下载次数: 6)

2011-12-30 08:47 上传

点击文件名下载附件

liuguansky

1. Public d As New Dictionary, Mr&
   
2. Sub j()
   
3.     Dim Arr, i&, Ar, Rng As Range
   
4.     Dim j As Byte, s$, arrt()
   
5.     With Worksheets("数源1")
   
6.         Arr = .Range("d9:g" & .Range("d9").End(4).Row).Value
   
7.     End With
   
8.     Ar = Array("迟到", "早退", "请假", "外出", "上班漏刷", "下班漏刷")
   
9.     d.RemoveAll
   
10.     For i = 0 To UBound(Ar)
    
11.         d.Add Ar(i), IIf(i > 4, 4, i)
    
12.     Next
    
13.     For i = 1 To UBound(Arr)
    
14.         If d.Exists(Arr(i, 1)) Then
    
15.             Ar = d(Arr(i, 1))
    
16.             Ar(d(Arr(i, 4))) = Ar(d(Arr(i, 4))) + 1
    
17.             d(Arr(i, 1)) = Ar
    
18.         Else
    
19.             Ar = Array(0, 0, 0, 0, 0)
    
20.             Ar(d(Arr(i, 4))) = Ar(d(Arr(i, 4))) + 1
    
21.             d(Arr(i, 1)) = Ar
    
22.         End If
    
23.     Next i
    
24.     With Worksheets("数源2")
    
25.         Arr = .Range(.[a3], .[a3].End(4)).Value
    
26.         s = "外出"
    
27.         For i = 1 To UBound(Arr)
    
28.             If d.Exists(Arr(i, 1)) Then
    
29.                 Ar = d(Arr(i, 1))
    
30.                 Ar(d(s)) = Ar(d(s)) + 1
    
31.                 d(Arr(i, 1)) = Ar
    
32.             Else
    
33.                 Ar = Array(0, 0, 0, 0, 0)
    
34.                 Ar(d(s)) = Ar(d(s)) + 1
    
35.                 d(Arr(i, 1)) = Ar
    
36.             End If
    
37.         Next
    
38.         Set Rng = .Cells.Find("请假、 记事")
    
39.         If Not Rng Is Nothing Then
    
40.             Arr = .Range(.Cells(Rng.Row + 1, 1), .Cells(Rng.Row + 1, 1).End(4)).Value
    
41.             s = "请假"
    
42.             For i = 1 To UBound(Arr)
    
43.                 If d.Exists(Arr(i, 1)) Then
    
44.                     Ar = d(Arr(i, 1))
    
45.                     Ar(d(s)) = Ar(d(s)) + 1
    
46.                     d(Arr(i, 1)) = Ar
    
47.                 Else
    
48.                     Ar = Array(0, 0, 0, 0, 0)
    
49.                     Ar(d(s)) = Ar(d(s)) + 1
    
50.                     d(Arr(i, 1)) = Ar
    
51.                 End If
    
52.             Next
    
53.         End If
    
54.     End With
    
55.     With Worksheets("统计")
    
56.         Mr = .Cells.Find("说明：", lookat:=xlPart).Row - 3
    
57.         Call Fh(.Range("a3"))
    
58.         Call Fh(.Range("i3"))
    
59.         Call Fh(.Range("q3"))
    
60.     End With
    
61. End Sub
    
62. Sub Fh(Rng As Range)
    
63.     Dim arrt(), i&, j As Byte
    
64.     Arr = Worksheets("统计").Range(Rng, Rng.End(4)).Value
    
65.     ReDim arrt(1 To UBound(Arr), 1 To 6)
    
66.     For i = 1 To UBound(Arr)
    
67.         If d.Exists(Arr(i, 1)) Then
    
68.             Ar = d(Arr(i, 1))
    
69.             For j = 0 To 4
    
70.                 arrt(i, j + 2) = Ar(j)
    
71.             Next j
    
72.             arrt(i, 1) = (arrt(i, 2) + arrt(i, 3) + arrt(i, 6)) * 0.5
    
73.         End If
    
74.     Next i
    
75.     Rng.Offset(0, 2).Resize(Mr, 6).ClearContents
    
76.     Rng.Offset(0, 2).Resize(UBound(arrt), 6) = arrt
    
77. End Sub
    

复制代码

20111229.rar (26.16 KB, 下载次数: 7)

2011-12-30 09:56 上传

点击文件名下载附件
请参看是否为附件效果。

gmshe58

liuguansky 发表于 2011-12-30 09:57
请参看是否为附件效果。

谢谢，基本是这样的，但是，九年级、工作人员没有统计，该如何改？
要求：统计私事外出次数，私事请假次数，公事不统计。该如何改？
。每两次漏刷等于一次旷工，不加其它的（如请假、外出等不加入计算）

gmshe58

liuguansky 发表于 2011-12-30 09:57
请参看是否为附件效果。

要么把数据源2分开为2个：临时外出、请假记事（分私事，公事、学习开会、法定假、产假、忘记刷卡有录像等等）。

liuguansky

1. 
   
2. Public d As New Dictionary, Mr&
   
3. Sub j()
   
4.     Dim Arr, i&, Ar, Rng As Range
   
5.     Dim j As Byte, s$, arrt()
   
6.     With Worksheets("数源1")
   
7.         Arr = .Range("d9:g" & .Range("d9").End(4).Row).Value
   
8.     End With
   
9.     Ar = Array("迟到", "早退", "请假", "外出", "上班漏刷", "下班漏刷")
   
10.     d.RemoveAll
    
11.     For i = 0 To UBound(Ar)
    
12.         d.Add Ar(i), IIf(i > 4, 4, i)
    
13.     Next
    
14.     For i = 1 To UBound(Arr)
    
15.         If d.Exists(Arr(i, 1)) Then
    
16.             Ar = d(Arr(i, 1))
    
17.             Ar(d(Arr(i, 4))) = Ar(d(Arr(i, 4))) + 1
    
18.             d(Arr(i, 1)) = Ar
    
19.         Else
    
20.             Ar = Array(0, 0, 0, 0, 0)
    
21.             Ar(d(Arr(i, 4))) = Ar(d(Arr(i, 4))) + 1
    
22.             d(Arr(i, 1)) = Ar
    
23.         End If
    
24.     Next i
    
25.     With Worksheets("数源2")
    
26.         Arr = .Range(.[a3], .[e3].End(4)).Value
    
27.         s = "外出"
    
28.         For i = 1 To UBound(Arr)
    
29.             If Arr(i, 5) Like "*私事*" Then
    
30.                 If d.Exists(Arr(i, 1)) Then
    
31.                     Ar = d(Arr(i, 1))
    
32.                     Ar(d(s)) = Ar(d(s)) + 1
    
33.                     d(Arr(i, 1)) = Ar
    
34.                 Else
    
35.                     Ar = Array(0, 0, 0, 0, 0)
    
36.                     Ar(d(s)) = Ar(d(s)) + 1
    
37.                     d(Arr(i, 1)) = Ar
    
38.                 End If
    
39.             End If
    
40.         Next
    
41.         Set Rng = .Cells.Find("请假、 记事")
    
42.         If Not Rng Is Nothing Then
    
43.             Arr = .Range(.Cells(Rng.Row + 1, 1), .Cells(Rng.Row + 1, 5).End(4)).Value
    
44.             s = "请假"
    
45.             For i = 1 To UBound(Arr)
    
46.                 If Arr(i, 5) Like "*私事*" Then
    
47.                     If d.Exists(Arr(i, 1)) Then
    
48.                         Ar = d(Arr(i, 1))
    
49.                         Ar(d(s)) = Ar(d(s)) + 1
    
50.                         d(Arr(i, 1)) = Ar
    
51.                     Else
    
52.                         Ar = Array(0, 0, 0, 0, 0)
    
53.                         Ar(d(s)) = Ar(d(s)) + 1
    
54.                         d(Arr(i, 1)) = Ar
    
55.                     End If
    
56.                 End If
    
57.             Next
    
58.         End If
    
59.     End With
    
60.     With Worksheets("统计")
    
61.         Mr = .Cells.Find("说明：", lookat:=xlPart).Row - 3
    
62.         Call Fh(.Range("a3"))
    
63.         Call Fh(.Range("i3"))
    
64.         Call Fh(.Range("q3"))
    
65.         Call Fh(.Range("y3"))
    
66.         Call Fh(.Range("ag3"))
    
67.     End With
    
68. End Sub
    
69. Sub Fh(Rng As Range)
    
70.     Dim arrt(), i&, j As Byte
    
71.     Arr = Worksheets("统计").Range(Rng, Rng.End(4)).Value
    
72.     ReDim arrt(1 To UBound(Arr), 1 To 6)
    
73.     For i = 1 To UBound(Arr)
    
74.         If d.Exists(Arr(i, 1)) Then
    
75.             Ar = d(Arr(i, 1))
    
76.             For j = 0 To 4
    
77.                 arrt(i, j + 2) = Ar(j)
    
78.             Next j
    
79.             arrt(i, 1) = (arrt(i, 2) + arrt(i, 3) + arrt(i, 6)) * 0.5
    
80.         End If
    
81.     Next i
    
82.     Rng.Offset(0, 2).Resize(Mr, 6).ClearContents
    
83.     Rng.Offset(0, 2).Resize(UBound(arrt), 6) = arrt
    
84. End Sub
    

复制代码

已修正
有冻结窗口。最后表的说明没注意看，不好意思
20111229.rar (26.17 KB, 下载次数: 19)

2011-12-30 12:02 上传

点击文件名下载附件

gmshe58

liuguansky 发表于 2011-12-30 11:57
已修正
有冻结窗口。最后表的说明没注意看，不好意思

谢谢，辛苦了。顺便问两句：1.Public d As New Dictionary, Mr&   是什么意思？在同事的电脑室上说是：编辑错误 “找不到工程或库”，不运行。

gmshe58

SCRRUN.DLL  在哪里？
烦请明示，谢谢。

liuguansky

gmshe58 发表于 2011-12-30 23:00
SCRRUN.DLL  在哪里？
烦请明示，谢谢。

gmshe58

liuguansky 发表于 2011-12-31 09:04

加载错误，可能是他的电脑装的时候是不完全的吧。没有解决办法的话，就让他用我的吧。以后再装时再说。谢谢。