如何按项目分开统计成表？

kayshao1986 · 发表于 2020-1-27 15:29

本帖最后由 kayshao1986 于 2020-1-30 14:14 编辑

各位老师新年好！小生工作每天都有一份发货单需要整理，要求按工程项目分类整理成固定格式列印出来，因为每次工程项目有很多，每次都需要整理很久，手动整理效率很低很低

，想请教下各位老师能否给出高效的方法？感激不尽

附表中，需要把不同项目工程名称的资料分开统计，资料都有，但我不懂怎么来操作，因为我只懂得简单的宏操作.

3190496160 · 发表于 2020-1-27 15:38

不仅仅要考虑工程项目，还得考虑加工单号吧？？？？？？

鄂龙蒙 · 发表于 2020-1-27 15:56

楼主是想按《项目名称+批次号》拆分吧

kayshao1986 · 发表于 2020-1-27 16:00

鄂龙蒙发表于 2020-1-27 15:56
楼主是想按《项目名称+批次号》拆分吧

是想把原始资料中整理成样式那样，按项目名称+批次号拆分统计

3190496160 · 发表于 2020-1-27 16:17

Sub 发货单()
Dim rng As Range
Set d = CreateObject("scripting.dictionary")
ar = Sheets("出仓原始数据").[a1].CurrentRegion
For i = 3 To UBound(ar)
If Trim(ar(i, 3)) <> "" And Trim(ar(i, 4)) <> "" Then
      s = Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
      d(s) = ""
End If
Next i
With Sheets("出货单")
For Each ss In .Shapes
      ss.Delete
Next ss
.UsedRange.Clear
For Each k In d.keys
      n = 0
      ReDim br(1 To UBound(ar), 1 To 15)
      For i = 3 To UBound(ar)
         ss = Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
         If ss = k Then
            n = n + 1
            br(n, 1) = n
            br(n, 2) = ar(i, 5) & "-" & ar(i, 7) & "-" & ar(i, 4)
            br(n, 3) = ar(i, 10)
            br(n, 4) = ar(i, 9)
            br(n, 5) = ar(i, 20)
            br(n, 6) = ar(i, 11)
            br(n, 7) = ar(i, 12)
            br(n, 8) = ar(i, 22)
            br(n, 9) = ar(i, 25)
            br(n, 10) = ar(i, 19)
            br(n, 11) = ar(i, 21)
            br(n, 12) = ar(i, 13)
            br(n, 13) = ar(i, 13) - ar(i, 22) - ar(i, 26)
            br(n, 14) = ar(i, 16)
            bh = ar(i, 23)
            sj = ar(i, 24)
         End If
      Next i
      M = Sheets("出货单").Cells(Rows.Count, 1).End(xlUp).Row + 1
      If M = 2 Then
         M = 1
      Else
         M = M
      End If
      Sheets("样式表头").Rows("1:4").Copy .Cells(M, 1)
      .Cells(M + 1, 2) = Split(k, "|")(0)
      Set rng = Sheets("收货人信息").Columns(1).Find(Split(k, "|")(0), , , 1)
      If Not rng Is Nothing Then
         .Cells(M + 1, 8) = Sheets("收货人信息").Cells(rng.Row, 2)
         .Cells(M + 1, 10) = Sheets("收货人信息").Cells(rng.Row, 3)
      End If
      .Cells(M + 1, 13) = bh
      .Cells(M + 1, 15) = sj
      .Cells(M + 4, 1).Resize(n, UBound(br, 2)) = br
      .Cells(M + 4, 1).Resize(n, UBound(br, 2)).Borders.LineStyle = 1
      Sheets("样式表头").Rows("10:11").Copy .Cells(M + n + 4, 1)
      .Cells(M + n + 4, 8) = Application.Sum(Application.Index(br, 0, 8))
      .Cells(M + n + 4, 9) = Application.Sum(Application.Index(br, 0, 9))
      .Cells(M + n + 4, 12) = Application.Sum(Application.Index(br, 0, 12))
      .Cells(M + n + 4, 13) = Application.Sum(Application.Index(br, 0, 13))
Next k
End With
End Sub

3190496160 · 发表于 2020-1-27 16:19

样品.zip (27.57 KB, 下载次数: 125)

3190496160 · 发表于 2020-1-27 16:20

收货人信息中的项目名称必须跟数据源中的项目名称一致，

kayshao1986 · 发表于 2020-1-27 19:34

3190496160 发表于 2020-1-27 16:20
收货人信息中的项目名称必须跟数据源中的项目名称一致，

厉害！老师~
就是这效果。能不能加个备注？如不是首次出货，需备注上次出货数量

3190496160 · 发表于 2020-1-28 09:36

kayshao1986 发表于 2020-1-27 19:34
厉害！老师~
就是这效果。能不能加个备注？如不是首次出货，需备注上次出货数量

呵呵，根据什么来判断是否是首次出货？？？？上次出货数量在哪里？？？？别人不是做你的工作的，别指望别人什么都明白

3190496160 · 发表于 2020-1-28 09:50

放到备注栏中
Sub 发货单()
Dim rng As Range
Set d = CreateObject("scripting.dictionary")
ar = Sheets("出仓原始数据").[a1].CurrentRegion
For i = 3 To UBound(ar)
If Trim(ar(i, 3)) <> "" And Trim(ar(i, 4)) <> "" Then
      s = Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
      d(s) = ""
End If
Next i
With Sheets("出货单")
For Each ss In .Shapes
      ss.Delete
Next ss
.UsedRange.Clear
For Each k In d.keys
      n = 0
      ReDim br(1 To UBound(ar), 1 To 15)
      For i = 3 To UBound(ar)
         ss = Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
         If ss = k Then
            n = n + 1
            br(n, 1) = n
            br(n, 2) = ar(i, 5) & "-" & ar(i, 7) & "-" & ar(i, 4)
            br(n, 3) = ar(i, 10)
            br(n, 4) = ar(i, 9)
            br(n, 5) = ar(i, 20)
            br(n, 6) = ar(i, 11)
            br(n, 7) = ar(i, 12)
            br(n, 8) = ar(i, 22)
            br(n, 9) = ar(i, 25)
            br(n, 10) = ar(i, 19)
            br(n, 11) = ar(i, 21)
            br(n, 12) = ar(i, 13)
            br(n, 13) = ar(i, 13) - ar(i, 22) - ar(i, 26)
            If ar(i, 26) > 0 Then
                  br(n, 15) = "上次出货数量" & ar(i, 26)
            Else
                  br(n, 15) = ""
            End If
            br(n, 14) = ar(i, 16)
            bh = ar(i, 23)
            sj = ar(i, 24)
         End If
      Next i
      M = Sheets("出货单").Cells(Rows.Count, 1).End(xlUp).Row + 1
      If M = 2 Then
         M = 1
      Else
         M = M
      End If
      Sheets("样式表头").Rows("1:4").Copy .Cells(M, 1)
      .Cells(M + 1, 2) = Split(k, "|")(0)
      Set rng = Sheets("收货人信息").Columns(1).Find(Split(k, "|")(0), , , 1)
      If Not rng Is Nothing Then
         .Cells(M + 1, 8) = Sheets("收货人信息").Cells(rng.Row, 2)
         .Cells(M + 1, 10) = Sheets("收货人信息").Cells(rng.Row, 3)
      End If
      .Cells(M + 1, 13) = bh
      .Cells(M + 1, 15) = sj
      .Cells(M + 4, 1).Resize(n, UBound(br, 2)) = br
      .Cells(M + 4, 1).Resize(n, UBound(br, 2)).Borders.LineStyle = 1
      Sheets("样式表头").Rows("10:11").Copy .Cells(M + n + 4, 1)
      .Cells(M + n + 4, 8) = Application.Sum(Application.Index(br, 0, 8))
      .Cells(M + n + 4, 9) = Application.Sum(Application.Index(br, 0, 9))
      .Cells(M + n + 4, 12) = Application.Sum(Application.Index(br, 0, 12))
      .Cells(M + n + 4, 13) = Application.Sum(Application.Index(br, 0, 13))
Next k
End With
End Sub

		自动登录	找回密码
密码			免费注册

[已解决] 如何按项目分开统计成表？

评分

评分