|
表的个数不受限制。见代码:
Sub hz()
Dim ar()
Application.ScreenUpdating = False
Sheet2.Range("a3:g65536").ClearContents
Set shdw = Cells.Find("午餐鸡肉")
If Not shdw Is Nothing Then ydz = shdw.Address
Do While Not shdw Is Nothing
h = shdw.Row: c = shdw.Column
For i = h + 1 To 100
If Cells(i, c - 1) = "合计" Then Exit For
ReDim Preserve ar(1 To 7, 1 To n + 1)
ar(1, n + 1) = Cells(h - 2, c - 2)
ar(2, n + 1) = ar(2, n + 1) + Cells(i, c)
ar(3, n + 1) = ar(3, n + 1) + Cells(i, c + 1)
ar(4, n + 1) = ar(4, n + 1) + Cells(i, c + 2)
ar(5, n + 1) = ar(5, n + 1) + Cells(i, c + 3)
ar(6, n + 1) = ar(6, n + 1) + Cells(i, c + 4)
ar(7, n + 1) = ar(7, n + 1) + Cells(i, c + 5)
Next i
n = n + 1
Set shdw = Cells.FindNext(After:=shdw)
If ydz = shdw.Address Then Exit Do
Loop
Sheet2.Range("a3").Resize(UBound(ar, 2), UBound(ar)) = Application.Transpose(ar)
Sheet2.Select
Application.ScreenUpdating = True
End Sub |
|