请帮忙将一个工作表中的多张送货单自动生成汇总表

liangmutou01

Sub cs()
  Dim ar()
  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 + 2 To h + 16
      If Cells(i, c + 1) <> "" Then
        ReDim Preserve ar(1 To 6, 1 To n + 1)
        ar(1, n + 1) = Cells(i, c)
        ar(2, n + 1) = Cells(h, c + 2)
        ar(3, n + 1) = Cells(i, c + 1)
        ar(4, n + 1) = Cells(i, c + 2)
        ar(5, n + 1) = Cells(i, c + 3)
        ar(6, n + 1) = Cells(h + 16, c + 8)
        n = n + 1
      End If
    Next i
    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)
End Sub

MEI0126

liangmutou01 发表于 2019-10-11 22:12
Sub cs()
  Dim ar()
  Set shdw = Cells.Find("收货单位：")

谢谢你，这个表已经搞好了，不过还有另一个表也是要做这样子的汇总，格式不一样，不能套用，可以麻烦你帮我做个自动生成的模版吗？不会VBA，不会写代码呢。附件我放在下一楼，麻烦你帮一下

MEI0126

麻烦帮我做一个多张送货单自动生成汇总表的模版，十分感谢。

liangmutou01

表的个数不受限制。见代码：
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

liangmutou01

把程序文件发给你。

栋帅

xuemei0216 发表于 2019-10-11 09:50
改好了，你看一下

您这个表做的真好，我有一个问题请问您一下，品名的下拉菜单怎么编辑

lusa

太好用了以后试试

唐瞬

xuemei0216 发表于 2019-10-10 18:53
看看，是不是你想要的

请问你这个是怎么处理的，可以教教吗，