怎么自动生成配送数据

绝世梦想

各位高手，代码经过修改，功能实现了98%，现在问题是：时间取的不精确，自动编号为什么第一个有三行是错误 的？请帮我再改改，以便最终达到目的

Sub 早餐配送()
    Dim Arr, brr, crr, drr, err, d As Object, rr%, i%, j%, m%, n%, r%, t%, d1 As Object, d2 As Object
    On Error Resume Next
   t = Application.CountA(Sheets("就餐人数").[A5:A73]) - 1
   Sheets("配送数据").Rows("2:50000").ClearContents
    Arr = Sheets("一周菜谱").[A1].CurrentRegion
    brr = Sheets("菜谱库").[A1].CurrentRegion
    drr = Sheets("就餐人数").[A1].CurrentRegion
    err = Sheets("配送数据").[A1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    For r = 5 To t + 5
    For rr = 3 To UBound(Arr, 1) Step 5
        For i = 0 To 4
            For j = 2 To UBound(Arr, 2)
                If Arr(rr + i, j) <> "" Then
                    For m = 2 To UBound(brr)
                        If Arr(rr + i, j) = brr(m, 2) Then
                            crr = Split(brr(m, 3), "；")
                            For n = 0 To UBound(crr)
                           
                                d(Split(crr(n), "，")(0)) = d(Split(crr(n), "，")(0)) + Val(Split(crr(n), "，")(1)) * drr(r, j + 3) / 500
                             
                            Next n
                        End If
                    Next m
                End If
            Next j
        Next i
        
        With Sheets("配送数据")
        m = Application.CountA(.[E:E])
        n = Application.CountA(.[D:D])
               
        Sheets("配送数据").Cells(m + 1, 4).Resize(d.Count) = Sheets("就餐人数").Cells(r, 1)
        Sheets("配送数据").Cells(m + 1, 3).Resize(d.Count) = "PC" & Format(.Cells(i, "B"), "yyyymmdd") & Sheets("就餐人数").Cells(r, 26) '生成单号
        
        Sheets("配送数据").Cells(m + 1, 5).Resize(d.Count) = Application.Transpose(d.keys)
        Sheets("配送数据").Cells(m + 1, 7).Resize(d.Count) = Application.Transpose(d.items)
        
        Sheets("配送数据").Range("k" & m + 1 & ":k" & r) = "=""非营养餐"""
        Sheets("配送数据").[f2] = "=VLOOKUP(E2,基础资料!$L$1:$N$132,2,0)"
        Sheets("配送数据").Range("f" & m + 1 & ":f" & r).FillDown
        Sheets("配送数据").[h2] = "=VLOOKUP(E2,基础资料!$L$1:$N$132,3,0)"
        Sheets("配送数据").Range("h" & m + 1 & ":h" & r).FillDown
        Sheets("配送数据").[j2] = "=VLOOKUP(D2,基础资料!$A$1:$I$70,9,0)"
        Sheets("配送数据").Range("j" & m + 1 & ":j" & r).FillDown
       For i = 0 To m
       Sheets("配送数据").Cells(i + 2, "I") = Sheets("配送数据").Cells(i + 2, "G") * Sheets("配送数据").Cells(i + 2, "H ")
        Sheets("配送数据").Cells(i + 2, 2).Resize(d.Count) = "=TODAY()-WEEKDAY(TODAY())+2"
       Next
        End With

        d.RemoveAll
    Next rr
   Next r
    Set d = Nothing
    Sheets("配送数据").Select
End Sub