[已解决]将多个工作表中,符合条件格式的内容,汇总到一个工作表中.求各位高手指点代码哪出错了

txj

首先要感谢----dsmch 的朋友提供的在单个工作表中汇总过期物料的代码.非常感谢,辛苦了!!!

我的工作簿中有 N多个工作表,每份工作表都可能有到期的物料.
我是想把每份工作表中到期的物料通 过代码自动汇总到一个工表中(如果是手动添加,工作量很大)
我起初是想通过底色区分来实现自动添加到期物料,不想我写的代码不能识别底色(应该是我的代码写的有误)
我重新做了一下表格(见附件),代码如下:
Sub 报()
Dim arr, brr, i, s, x
For x = 2 To Sheets.Count
arr = Sheets(x).Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 5)
For i = 2 To UBound(arr)
    If arr(i, 3) > Now And arr(i, 3) - Now < 30 Then
        s = s + 1
        brr(s, 1) = Now
        brr(s, 2) = "磁芯"
        brr(s, 3) = arr(i, 2)
        brr(s, 4) = arr(i, 1)
        brr(s, 5) = arr(i, 3)
    End If
Next
Sheets("报").[a:a].NumberFormatLocal = "yyyy-mm-dd"
Sheets("报").Range("a3").Resize(s, 5) = brr
Next
End SuB

我将dsmch的朋友的代码做了一点改动(在这儿再次感谢您,辛苦了)
用"F8"键测试过了,只能保留最后一次的结果,之前的结果出现了,但不能保留.应该是我改的不对
如果有幸再次被dsmch的朋友看到,还烦请 多多指点,不胜感激
如果被其他的高手看到此条求助,同样烦请指点,有劳大家了!!!

最佳答案

月排行榜 / 总排行榜

xdragon

2014-10-3 11:30

Sheets("报").Range("a" & Sheets("报").Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(s, 5) = brr
s = 0

这是从你的代码直接修改的。只需要改这两个地方就好了。
不过建议你直接放一个数组。用下面的代码吧

1. Sub 报1()
   
2. Dim arr, brr(1 To 10000, 1 To 5), i, s, x
   
3. For x = 2 To Sheets.Count
   
4.    arr = Sheets(x).Range("a1:c11")
   
5.    For i = 2 To UBound(arr)
   
6.        If arr(i, 3) > Date And arr(i, 3) - Date < 30 Then
   
7.         s = s + 1
   
8.         brr(s, 1) = Date
   
9.         brr(s, 2) = "磁芯"
   
10.         brr(s, 3) = arr(i, 2)
    
11.         brr(s, 4) = arr(i, 1)
    
12.         brr(s, 5) = arr(i, 3)
    
13.        End If
    
14.    Next
    
15. Next
    
16. Sheets("报").[a3].Resize(s, 5) = brr
    
17. End Sub

复制代码

跳转到最佳答案楼层

xdragon

Sheets("报").Range("a" & Sheets("报").Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(s, 5) = brr
s = 0

这是从你的代码直接修改的。只需要改这两个地方就好了。
不过建议你直接放一个数组。用下面的代码吧

1. Sub 报1()
   
2. Dim arr, brr(1 To 10000, 1 To 5), i, s, x
   
3. For x = 2 To Sheets.Count
   
4.    arr = Sheets(x).Range("a1:c11")
   
5.    For i = 2 To UBound(arr)
   
6.        If arr(i, 3) > Date And arr(i, 3) - Date < 30 Then
   
7.         s = s + 1
   
8.         brr(s, 1) = Date
   
9.         brr(s, 2) = "磁芯"
   
10.         brr(s, 3) = arr(i, 2)
    
11.         brr(s, 4) = arr(i, 1)
    
12.         brr(s, 5) = arr(i, 3)
    
13.        End If
    
14.    Next
    
15. Next
    
16. Sheets("报").[a3].Resize(s, 5) = brr
    
17. End Sub

复制代码