根据某列的客户名来生成每个客户的出货单并保存为PDF

百读谷歌

原要求如下：

客户的出货单，数量多，比较琐碎。 要求自动筛选出每个客户的出货明细，并且自动按照设定好的格式保存为PDF用A5纸打印

附件中的表格是原本有坛友帮忙设定的格式，这个格式“车费”在“合计”的下面。
现在我想把“车费”调到上面，并且自动计算车费，然后再合计总金额！

具体附件中有详细说明，麻烦各位大佬相助！！感恩！祝大家新年快乐！！！

LIUZHU

这个表设计得就很不合理，把原始数据和要输出的数据设计在一个表上，我也是佩服。一般来说，原始数据和输出结果在不同的表格，才方便代码设计。

shiruiqiang

刚才误串，信息错误

shiruiqiang

个人建议先把表格设计规范点吧，否则你上传的示范就算论坛里的各位老师现在给你写好，还是要返工的。

3190496160

Sub TEST4()
    Dim arr, brr, i&, j&, R&, dic As Object, vKey
    Set d = CreateObject("Scripting.Dictionary")
    R = Cells(Rows.Count, 16).End(xlUp).Row
    arr = Range("j1:r" & R)
    For i = 2 To UBound(arr)
      If arr(i, 7) <> "" Then
        d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 9) ''累计车费
      End If
    Next i
   
    For Each k In d.keys
       n = 0: hj = 0
       ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
       brr(UBound(brr), 7) = "车费": brr(UBound(brr) - 1, 7) = "合计"
       For i = 1 To UBound(arr)
          If VBA.Trim(arr(i, 1)) = k Then
             n = n + 1
             For j = 1 To UBound(brr, 2)
                brr(n, j) = arr(i, j)
             Next j
             hj = hj + arr(i, 7) ''累计金额
          End If
       Next i
       n = n + 1
       brr(n, 1) = k
       brr(n, 2) = "车费"
       brr(n, 6) = "="
       brr(n, 7) = d(k) ''车费
       n = n + 2
       brr(n, 7) = "合计"
       brr(n, 8) = Int(hj + d(k)) '''合计
       rs = Cells(Rows.Count, 7).End(xlUp).Row
       If rs >= 7 Then Range("A7:h" & rs) = Empty
       [A8].Resize(n, UBound(brr, 2)) = brr
       ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & n + 7 ''设置打印区域
       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & k & Format(Now(), "yyyymmdd")
    Next k
    Set d = Nothing
End Sub

3190496160

123.rar (20.24 KB, 下载次数: 23)

2023-1-25 09:02 上传

点击文件名下载附件

3190496160

这种表格设计太奇葩，代码仅供参考

百读谷歌

3190496160 发表于 2023-1-25 09:02

完美完美！！！超级好用！因为是小店铺，肯定和大公司的表格不能相比的，表格设计参照老板平日手写习惯而设计的！！再次感谢！！

百读谷歌

3190496160 发表于 2023-1-25 09:02

大神你好，我用了几天发现一个bug，有时候会报“下标越界”。我尝试自己咨询坛友解决，但是没找到方法。能不能请您再看看是怎么回事？实在不好意思。。

tanglf188

百读谷歌 发表于 2023-2-6 20:10
大神你好，我用了几天发现一个bug，有时候会报“下标越界”。我尝试自己咨询坛友解决，但是没找到方法。 ...

仅仅为了打印不与要导出PDF吧，直接设定打印区域就可以了。