[已解决]数值累加到另一张表内，求解决啊。。

jnsday

急求啊，其中有一些功能还没有实现。。
我的表格内有3张表
我想在数据表内的菜名通过 按钮命令后
1、自动根据名称另存为 （已实现）
2、把表内的数据 累加到第三章表“每日统计”内 （未实现）
3、自动把“数据”表内的信息清空 （未实现）

求大神实现啊~~~~

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2013-11-14 19:12

后两个要求见附件内TEST按钮，不是我说，你最好从基础开始学，都是搬来的代码，整合的也不行。

1. Private Sub CommandButton2_Click()
   
2. Dim arr, i&, j&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("d9:f" & [d65536].End(3).Row)
   
5. For i = 1 To UBound(arr)
   
6.   If arr(i, 3) <> "" Then d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 3)
   
7. Next i
   
8. With Sheets(3)
   
9.   arr = .Range("a4:i" & .[a65536].End(3).Row)
   
10.   For j = 1 To UBound(arr, 2) Step 3
    
11.     For i = 1 To UBound(arr)
    
12.       If arr(i, j + 1) = "" Then Exit For
    
13.       arr(i, j + 2) = arr(i, j + 2) + d(arr(i, j + 1))
    
14.     Next i
    
15.   Next j
    
16.   .[a4].Resize(UBound(arr), UBound(arr, 2)) = arr
    
17. End With
    
18. Range("d9:g" & [d65536].End(3).Row).ClearContents
    
19. End Sub

复制代码

跳转到最佳答案楼层

sgyzzz

3、自动把“数据”表内的信息清空 （未实现）
执行一步单元格内容清除

jnsday

sgyzzz 发表于 2013-11-13 10:13
3、自动把“数据”表内的信息清空 （未实现）
执行一步单元格内容清除

恩。。这个我也晓得。。。
不是很难。。

jnsday

额  木有人啊。。。。。

jnsday

我来试试。。。
@liuguansky

云影

jnsday 发表于 2013-11-14 12:05
额  木有人啊。。。。。

1. Sub bc()
   
2. Dim m As Integer, s As Integer
   
3. For m = 4 To 32
   
4. For s = 9 To 17
   
5. If Sheets("数据").Range("d" & s) = Sheets("每日统计").Cells(m, "B") Then
   
6. Sheets("每日统计").Cells(m, "C") = Sheets("数据").Range("F" & s) + Sheets("每日统计").Cells(m, "C")
   
7. ElseIf Sheets("数据").Range("d" & s) = Sheets("每日统计").Cells(m, "E") Then
   
8. Sheets("每日统计").Cells(m, "F") = Sheets("数据").Range("F" & s) + Sheets("每日统计").Cells(m, "F")
   
9. ElseIf Sheets("数据").Range("d" & s) = Sheets("每日统计").Cells(m, "H") Then
   
10. Sheets("每日统计").Cells(m, "I") = Sheets("数据").Range("F" & s) + Sheets("每日统计").Cells(m, "I")
    
11. End If
    
12. Next
    
13. Next
    
14. Sheets("数据").Range("f9:f22").Select
    
15. Selection.ClearContents
    
16. End Sub
    

复制代码

是这样吗？
应该还更简单的办法，不过我也是刚刚学习代码，不会{:1512:}

大灰狼1976

后两个要求见附件内TEST按钮，不是我说，你最好从基础开始学，都是搬来的代码，整合的也不行。

1. Private Sub CommandButton2_Click()
   
2. Dim arr, i&, j&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("d9:f" & [d65536].End(3).Row)
   
5. For i = 1 To UBound(arr)
   
6.   If arr(i, 3) <> "" Then d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 3)
   
7. Next i
   
8. With Sheets(3)
   
9.   arr = .Range("a4:i" & .[a65536].End(3).Row)
   
10.   For j = 1 To UBound(arr, 2) Step 3
    
11.     For i = 1 To UBound(arr)
    
12.       If arr(i, j + 1) = "" Then Exit For
    
13.       arr(i, j + 2) = arr(i, j + 2) + d(arr(i, j + 1))
    
14.     Next i
    
15.   Next j
    
16.   .[a4].Resize(UBound(arr), UBound(arr, 2)) = arr
    
17. End With
    
18. Range("d9:g" & [d65536].End(3).Row).ClearContents
    
19. End Sub

复制代码

sgyzzz

楼上用字典的方法汇总速度快。

jnsday

大灰狼1976 发表于 2013-11-14 19:12
后两个要求见附件内TEST按钮，不是我说，你最好从基础开始学，都是搬来的代码，整合的也不行。

感谢大神帮忙。。。
现在工作都没用到过编程，以前学的都过去5-6年了，都忘得差不多了。。
最近才开始重新学习数组跟字典的结合。。

jnsday

云影 发表于 2013-11-14 18:26
是这样吗？
应该还更简单的办法，不过我也是刚刚学习代码，不会

谢谢帮忙了哦~~~我都以为已经不会有人来回答了呢~~
真实黑暗中的一点曙光~~