求大神帮忙更新下代码让他继续运行

百读谷歌

这是之前论坛大神帮忙弄的，
一个是自动批量打印单个客户出货单的表格
一个是自动保存出货单为PDF的表格。
现在我改动了表格，代码不能正确运行了。
能不能帮我再更新一下让他继续运行？？麻烦了！！

于箱长

我猜你这个改动后也不是最后结果

djh372000

论坛高手多

3190496160

arr = Range("j1", Cells(Rows.Count, "p").End(xlUp))

3190496160

chzsh

试试这个吧

chzsh

Sub TEST3()
    Dim arr, brr, i&, j&, R&, dic As Object, vKey
    Set dic = CreateObject("Scripting.Dictionary")
    k = Range("p65536").End(xlUp).Row
    arr = Range("j1:p" & k)
    For i = 2 To UBound(arr)
      If arr(i, 7) <> "" Then
        dic(arr(i, 1)) = dic(arr(i, 1)) + 1
      End If
    Next i
   
    For Each vKey In dic.keys
       R = 0: ReDim brr(1 To dic(vKey) + 3, 1 To UBound(arr, 2))
       brr(UBound(brr), 6) = "车费": brr(UBound(brr) - 1, 6) = "合计"
       For i = 1 To UBound(arr)
          If arr(i, 1) = vKey Then
             R = R + 1
             For j = 1 To UBound(brr, 2)
                brr(R, j) = arr(i, j)
             Next j
             brr(UBound(brr) - 1, 7) = brr(UBound(brr) - 1, 7) + arr(i, 7)
          End If
       Next i
       Range("A7:G28") = Empty
       [A8].Resize(UBound(brr), UBound(brr, 2)) = brr
       ActiveSheet.PrintOut
    Next

    Set dic = Nothing
End Sub


Sub TEST4()
    Dim arr, brr, i&, j&, R&, dic As Object, vKey
    Set dic = CreateObject("Scripting.Dictionary")
    k = Range("p65536").End(xlUp).Row
    arr = Range("j1:p" & k)
    For i = 2 To UBound(arr)
      If arr(i, 7) <> "" Then
        dic(arr(i, 1)) = dic(arr(i, 1)) + 1
      End If
    Next i
   
    For Each vKey In dic.keys
       R = 0: ReDim brr(1 To dic(vKey) + 3, 1 To UBound(arr, 2))
       brr(UBound(brr), 6) = "车费": brr(UBound(brr) - 1, 6) = "合计"
       For i = 1 To UBound(arr)
          If arr(i, 1) = vKey Then
             R = R + 1
             For j = 1 To UBound(brr, 2)
                brr(R, j) = arr(i, j)
             Next j
             brr(UBound(brr) - 1, 7) = brr(UBound(brr) - 1, 7) + arr(i, 7)
          End If
       Next i
       Range("A7:G28") = Empty
       [A8].Resize(UBound(brr), UBound(brr, 2)) = brr
         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & vKey & Format(Now(), "yyyymmdd")
    Next

    Set dic = Nothing
End Sub

mafect

于箱长 发表于 2022-12-23 10:58
我猜你这个改动后也不是最后结果

言之有理！

百读谷歌

chzsh 发表于 2022-12-23 14:44
Sub TEST3()
    Dim arr, brr, i&, j&, R&, dic As Object, vKey
    Set dic = CreateObject("Scriptin ...

大神，这个“合计”和“车费”能不能帮我调回我原来在“金额”这一列的的位置？
主要是我这个还得手动添加车费和其他的一些杂费，我想在另外一列计算汇总！

百读谷歌

3190496160 发表于 2022-12-23 14:15
arr = Range("j1", Cells(Rows.Count, "p").End(xlUp))

只改动这个好像不太行呀？我改了之后出现了这个报错？下面还需要怎么修改吗？？