[已解决]在线求助！！急！急！ 改代码

文轩馨婷

grf1973 发表于 2014-5-7 11:43
这样可以了，不过最后要加一段删除空行的语句。

老师，

怎么我输入后还是有空白单元格（即各车间之间没有紧靠在一起）

grf1973

1. Sub 汇总各表数据()
   
2.     Dim N As Integer, M As Integer, A As Integer
   
3.     Rows("2:65536").Delete
   
4.     For N = 1 To 7       '要合并的工作表编号
   
5.         M = Sheets(N).[A65536].End(xlUp).Row   'A列的最后一个单元格所在的行号
   
6.         For k = M To 2 Step -1
   
7.             If Len(Sheets(N).Cells(k, 1)) > 0 Then Exit For
   
8.         Next
   
9.         If k >= 2 Then
   
10.             b = [A65536].End(xlUp).Row + 1    '目标位置空1行
    
11.             Sheets(N).Rows(2 & ":" & k).Copy    ' 从第2行开始复制各表数据到新工作台表中
    
12.             Cells(b, 1).PasteSpecial Paste:=xlPasteValues
    
13.             Cells(b, 1).PasteSpecial Paste:=xlPasteFormats
    
14.         End If
    
15.     Next N
    
16. End Sub

复制代码

grf1973

主要是用End(xlup)取最大行时，只要有公式，系统就认为是非空单元格。所以代码中加了6--8句，把A列有公式但无数值的行去掉。请看附件。

文轩馨婷

grf1973 发表于 2014-5-7 12:13
主要是用End(xlup)取最大行时，只要有公式，系统就认为是非空单元格。所以代码中加了6--8句，把A列有公式但 ...

谢谢！！

就是这个效果！

文轩馨婷

grf1973 发表于 2014-5-7 12:13
主要是用End(xlup)取最大行时，只要有公式，系统就认为是非空单元格。所以代码中加了6--8句，把A列有公式但 ...

老师：
    引用数据这个完成了，但旁边的汇总表又不成立了（汇总表是用函数完成）——并且每次“明细汇总表”重新汇总后定义出现错值（可否直接帮忙用VB完成？）

计算方法：当选择某月（如1月），那么“明细汇总表”中“各部门”日期月份等于1月份的“实际应补工时”汇总

以前的效果如附件（附件定义：补给工时=明细汇总!$N$2:$N$30000；申请日期=明细汇总!$B$2:$B$30000；生产车间=明细汇总!$A$2:$A$30000)

grf1973

主要是由于汇总明细时把行都删除后，名称定义不到对应区域引起的。两个办法解决：
1、汇总明细后把明细重新定义一下（我在代码中已补充进去。但我重新用公式后发现计算出错，可能是数据源中有文本型内容引起的。
2、直接用代码计算汇总。

1. Sub 汇总各表数据()
   
2.     Dim N As Integer, M As Integer, A As Integer
   
3.     With Sheets("明细汇总")
   
4.         .Rows("2:65536").Delete
   
5.         For N = 1 To 7       '要合并的工作表编号
   
6.             M = Sheets(N).[A65536].End(xlUp).Row   'A列的最后一个单元格所在的行号
   
7.             For k = M To 2 Step -1
   
8.                 If Len(Sheets(N).Cells(k, 1)) > 0 Then Exit For
   
9.             Next
   
10.             If k >= 2 Then
    
11.                 b = .[A65536].End(xlUp).Row + 1    '目标位置空1行
    
12.                 Sheets(N).Rows(2 & ":" & k).Copy    ' 从第2行开始复制各表数据到新工作台表中
    
13.                 .Cells(b, 1).PasteSpecial Paste:=xlPasteValues
    
14.                 .Cells(b, 1).PasteSpecial Paste:=xlPasteFormats
    
15.             End If
    
16.         Next N
    
17. '重新定义名称，酌情使用。。。。。。。。。。。。。。。
    
18. '        .Range("N2:N30000").Name = "补给工时"
    
19. '        .Range("B2:B30000").Name = "申请日期"
    
20. '        .Range("A2:A30000").Name = "生产车间"
    
21.     End With
    
22. End Sub
    
23. 
    
24. Sub 计算总表()
    
25.     Set d = CreateObject("scripting.dictionary")
    
26.     arr = Sheets("明细汇总").[a1].CurrentRegion
    
27.     For i = 2 To UBound(arr)
    
28.         xkey = arr(i, 1) & Month(arr(i, 2))
    
29.         d(xkey) = d(xkey) + Val(arr(i, 14))
    
30.     Next
    
31.     With Sheets("总表")
    
32.         For i = 3 To 9
    
33.             xkey = .Cells(i, 1) & .[b1]
    
34.             .Cells(i, 2) = d(xkey)
    
35.         Next
    
36.     End With
    
37. End Sub

复制代码

grf1973

请看附件。我用的是代码直接计算。1月份结果和你图片中的有一点不一样，自己检查一下吧。

文轩馨婷

grf1973 发表于 2014-5-7 13:44
请看附件。我用的是代码直接计算。1月份结果和你图片中的有一点不一样，自己检查一下吧。

是对的！


谢谢！！

youfang

顶一下拿答案