[已解决]求助大神帮忙，想对现有的代码 多增加一项数据

mathking77

运行代码 会生成每人的总和数据 数据会显示在N列开始到W列
现在我想把G列的“部门”数据 也生成在后面的X列
代码需要怎么增加

求指点

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-7-4 13:25

mathking77 发表于 2016-7-4 12:01
N列到W列的数据都是是根据H列I列J列这3列算出来的
N列O列P列数据是 是每人周1-5数据之和
Q R S 是 每人 ...

在原代码基础上修改如下：

1. Sub xx()
   
2.     Dim arr, brr(), n&, i&, dA, dB, dC, dD, dE, dF, dG, dH, dI, j&, dJ
   
3.     With Sheet1
   
4.         n = .Cells(.Rows.Count, 1).End(xlUp).Row
   
5.         arr = .Range("a2:J" & n)
   
6.         Set dA = CreateObject("Scripting.Dictionary")
   
7.         Set dB = CreateObject("Scripting.Dictionary")
   
8.         Set dC = CreateObject("Scripting.Dictionary")
   
9.         Set dD = CreateObject("Scripting.Dictionary")
   
10.         Set dE = CreateObject("Scripting.Dictionary")
    
11.         Set dF = CreateObject("Scripting.Dictionary")
    
12.         Set dG = CreateObject("Scripting.Dictionary")
    
13.         Set dH = CreateObject("Scripting.Dictionary")
    
14.         Set dI = CreateObject("Scripting.Dictionary")
    
15.         Set dJ = CreateObject("Scripting.Dictionary")
    
16.         For i = 1 To n - 1
    
17.             If Weekday(arr(i, 2), 2) < 6 Then
    
18.                 If dA.Exists(arr(i, 1)) Then
    
19.                     dA(arr(i, 1)) = dA(arr(i, 1)) + arr(i, 8)
    
20.                     dB(arr(i, 1)) = dB(arr(i, 1)) + arr(i, 9)
    
21.                     dC(arr(i, 1)) = dC(arr(i, 1)) + IIf(arr(i, 10) = "", 0, arr(i, 10))
    
22.                 Else
    
23.                     dA.Add arr(i, 1), arr(i, 8)
    
24.                     dB.Add arr(i, 1), arr(i, 9)
    
25.                     dC.Add arr(i, 1), IIf(arr(i, 10) = "", 0, arr(i, 10))
    
26.                     dJ.Add arr(i, 1), arr(i, 7)
    
27.                 End If
    
28.             ElseIf Weekday(arr(i, 2), 2) = 6 Then
    
29.                 If dA.Exists(arr(i, 1)) Then
    
30.                     dD(arr(i, 1)) = dD(arr(i, 1)) + arr(i, 8)
    
31.                     dE(arr(i, 1)) = dE(arr(i, 1)) + arr(i, 9)
    
32.                     dF(arr(i, 1)) = dF(arr(i, 1)) + IIf(arr(i, 10) = "", 0, arr(i, 10))
    
33.                 Else
    
34.                     dD.Add arr(i, 1), arr(i, 8)
    
35.                     dE.Add arr(i, 1), arr(i, 9)
    
36.                     dF.Add arr(i, 1), IIf(arr(i, 10) = "", 0, arr(i, 10))
    
37.                 End If
    
38.             ElseIf Weekday(arr(i, 2), 2) = 7 Then
    
39.                 If dA.Exists(arr(i, 1)) Then
    
40.                     dG(arr(i, 1)) = dG(arr(i, 1)) + arr(i, 8)
    
41.                     dH(arr(i, 1)) = dH(arr(i, 1)) + arr(i, 9)
    
42.                     dI(arr(i, 1)) = dI(arr(i, 1)) + IIf(arr(i, 10) = "", 0, arr(i, 10))
    
43.                 Else
    
44.                     dG.Add arr(i, 1), arr(i, 8)
    
45.                     dH.Add arr(i, 1), arr(i, 9)
    
46.                     dI.Add arr(i, 1), IIf(arr(i, 10) = "", 0, arr(i, 10))
    
47.                 End If
    
48.             End If
    
49.         Next
    
50.         x = 1
    
51.         For Each k In dA.keys
    
52.             x = x + 1
    
53.             .Cells(x, 14) = k
    
54.             .Cells(x, 15) = dA(k)
    
55.             .Cells(x, 16) = dB(k)
    
56.             .Cells(x, 17) = dC(k)
    
57.             .Cells(x, 18) = dD(k)
    
58.             .Cells(x, 19) = dE(k)
    
59.             .Cells(x, 20) = dF(k)
    
60.             .Cells(x, 21) = dG(k)
    
61.             .Cells(x, 22) = dH(k)
    
62.             .Cells(x, 23) = dI(k)
    
63.             .Cells(x, 24) = dJ(k)
    
64.         Next
    
65.      [N1].Value = "姓名"
    
66.      [O1].Value = "正常出勤时间"
    
67.      [P1].Value = "加点时间"
    
68.      [Q1].Value = "加点次数"
    
69.      [R1].Value = "周六白天"
    
70.      [S1].Value = "周六晚上"
    
71.      [T1].Value = "周六加点次数"
    
72.      [U1].Value = "周日白天"
    
73.      [V1].Value = "周日晚上"
    
74.      [W1].Value = "周日加点次数"
    
75.      [X1].Value = "部门"
    
76.     End With
    
77. End Sub

复制代码

跳转到最佳答案楼层

dsmch

代码太繁杂了，模拟结果，说明要求，用一个字典和数组就行了

mathking77

dsmch 发表于 2016-7-4 11:23
代码太繁杂了，模拟结果，说明要求，用一个字典和数组就行了

一个字典和数组的话 我加完后代码老报错 我也不知道为什么，
目前的代码是将A列，H，I，J列的数据   生成到了N列-W列

现在要求就是把G列的数据也生成到X列，大神请帮忙改一下发上来吗
万分感谢啊

mathking77

dsmch 发表于 2016-7-4 11:23
代码太繁杂了，模拟结果，说明要求，用一个字典和数组就行了

N列到W列的数据都是是根据H列I列J列这3列算出来的
N列O列P列数据是 是每人周1-5数据之和
Q R S 是 每人周6数据之和
T U W 是 每人周7数据之和

现在我就是想把每人对应的G列信息（部门） 加添到X列中 只是这样，前面的计算内容是不用改动的

老司机带带我

mathking77 发表于 2016-7-4 12:01
N列到W列的数据都是是根据H列I列J列这3列算出来的
N列O列P列数据是 是每人周1-5数据之和
Q R S 是 每人 ...

在原代码基础上修改如下：

1. Sub xx()
   
2.     Dim arr, brr(), n&, i&, dA, dB, dC, dD, dE, dF, dG, dH, dI, j&, dJ
   
3.     With Sheet1
   
4.         n = .Cells(.Rows.Count, 1).End(xlUp).Row
   
5.         arr = .Range("a2:J" & n)
   
6.         Set dA = CreateObject("Scripting.Dictionary")
   
7.         Set dB = CreateObject("Scripting.Dictionary")
   
8.         Set dC = CreateObject("Scripting.Dictionary")
   
9.         Set dD = CreateObject("Scripting.Dictionary")
   
10.         Set dE = CreateObject("Scripting.Dictionary")
    
11.         Set dF = CreateObject("Scripting.Dictionary")
    
12.         Set dG = CreateObject("Scripting.Dictionary")
    
13.         Set dH = CreateObject("Scripting.Dictionary")
    
14.         Set dI = CreateObject("Scripting.Dictionary")
    
15.         Set dJ = CreateObject("Scripting.Dictionary")
    
16.         For i = 1 To n - 1
    
17.             If Weekday(arr(i, 2), 2) < 6 Then
    
18.                 If dA.Exists(arr(i, 1)) Then
    
19.                     dA(arr(i, 1)) = dA(arr(i, 1)) + arr(i, 8)
    
20.                     dB(arr(i, 1)) = dB(arr(i, 1)) + arr(i, 9)
    
21.                     dC(arr(i, 1)) = dC(arr(i, 1)) + IIf(arr(i, 10) = "", 0, arr(i, 10))
    
22.                 Else
    
23.                     dA.Add arr(i, 1), arr(i, 8)
    
24.                     dB.Add arr(i, 1), arr(i, 9)
    
25.                     dC.Add arr(i, 1), IIf(arr(i, 10) = "", 0, arr(i, 10))
    
26.                     dJ.Add arr(i, 1), arr(i, 7)
    
27.                 End If
    
28.             ElseIf Weekday(arr(i, 2), 2) = 6 Then
    
29.                 If dA.Exists(arr(i, 1)) Then
    
30.                     dD(arr(i, 1)) = dD(arr(i, 1)) + arr(i, 8)
    
31.                     dE(arr(i, 1)) = dE(arr(i, 1)) + arr(i, 9)
    
32.                     dF(arr(i, 1)) = dF(arr(i, 1)) + IIf(arr(i, 10) = "", 0, arr(i, 10))
    
33.                 Else
    
34.                     dD.Add arr(i, 1), arr(i, 8)
    
35.                     dE.Add arr(i, 1), arr(i, 9)
    
36.                     dF.Add arr(i, 1), IIf(arr(i, 10) = "", 0, arr(i, 10))
    
37.                 End If
    
38.             ElseIf Weekday(arr(i, 2), 2) = 7 Then
    
39.                 If dA.Exists(arr(i, 1)) Then
    
40.                     dG(arr(i, 1)) = dG(arr(i, 1)) + arr(i, 8)
    
41.                     dH(arr(i, 1)) = dH(arr(i, 1)) + arr(i, 9)
    
42.                     dI(arr(i, 1)) = dI(arr(i, 1)) + IIf(arr(i, 10) = "", 0, arr(i, 10))
    
43.                 Else
    
44.                     dG.Add arr(i, 1), arr(i, 8)
    
45.                     dH.Add arr(i, 1), arr(i, 9)
    
46.                     dI.Add arr(i, 1), IIf(arr(i, 10) = "", 0, arr(i, 10))
    
47.                 End If
    
48.             End If
    
49.         Next
    
50.         x = 1
    
51.         For Each k In dA.keys
    
52.             x = x + 1
    
53.             .Cells(x, 14) = k
    
54.             .Cells(x, 15) = dA(k)
    
55.             .Cells(x, 16) = dB(k)
    
56.             .Cells(x, 17) = dC(k)
    
57.             .Cells(x, 18) = dD(k)
    
58.             .Cells(x, 19) = dE(k)
    
59.             .Cells(x, 20) = dF(k)
    
60.             .Cells(x, 21) = dG(k)
    
61.             .Cells(x, 22) = dH(k)
    
62.             .Cells(x, 23) = dI(k)
    
63.             .Cells(x, 24) = dJ(k)
    
64.         Next
    
65.      [N1].Value = "姓名"
    
66.      [O1].Value = "正常出勤时间"
    
67.      [P1].Value = "加点时间"
    
68.      [Q1].Value = "加点次数"
    
69.      [R1].Value = "周六白天"
    
70.      [S1].Value = "周六晚上"
    
71.      [T1].Value = "周六加点次数"
    
72.      [U1].Value = "周日白天"
    
73.      [V1].Value = "周日晚上"
    
74.      [W1].Value = "周日加点次数"
    
75.      [X1].Value = "部门"
    
76.     End With
    
77. End Sub

复制代码