【求助】取过来的行数是一样的，实际应该是不一样

huweifVB

I列内容+“C生产退料” 与出入库表的I列内容+B列=“C生产退料”时  出入库表的C到H内容复制到 退料单 表

I列内容+“D生产领料” 与出入库表的I列内容+B列=“D生产领料”时  出入库表的C到H内容复制到 出库单 表
我的目的是循环待处理表的I列 打印退料单和出库单，打印后再循环待处理表I列下一行
我自己写的存在2个问题
1、出库单匹配过来的行数与退料单一样（正确应该是出库单比退料单要多几行)
2、如果待处理有多行的时候，匹配过来的内容全部连在一起了
比如待处理有2行，每行匹配到的内容是20行，结果就20+20了，我要的是20行打印后清空再输入20行在打印

Sub 出库退库()
    Dim arr, drr, i, y, c, n, x
    With Sheets("待处理")
        drr = .Range("h2:I" & .Range("i" & Rows.Count).End(xlUp).Row)
    End With
   m = Sheets("出入库记录").Cells(Rows.Count, 1).End(3).Row
   arr = Sheets("出入库记录").Range("a1:i" & m)
    With Sheets("出入库记录")
       Trr = .Range("a1:i" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
ReDim brr(1 To UBound(Trr), 1 To 8), crr(1 To UBound(arr), 1 To 8)
For y = 1 To UBound(drr)
For i = 2 To UBound(arr)
    If arr(i, 2) & arr(i, 9) = "D生产领料" & drr(y, 2) Then
    Z = arr(i, 1)
        c = c + 1
        crr(c, 1) = arr(i, 3)
        crr(c, 2) = arr(i, 4)
        crr(c, 3) = arr(i, 5)
        crr(c, 4) = arr(i, 6)
        crr(c, 5) = arr(i, 7)
        crr(c, 6) = arr(i, 8)
    End If
Next
For T = 2 To UBound(Trr)
    If Trr(T, 2) & Trr(T, 9) = "C生产退料" & drr(y, 2) Then
    x = Trr(T, 1)
        n = n + 1
        brr(n, 1) = Trr(T, 3)
        brr(n, 2) = Trr(T, 4)
        brr(n, 3) = Trr(T, 5)
        brr(n, 4) = Trr(T, 6)
        brr(n, 5) = Trr(T, 7)
        brr(n, 6) = Trr(T, 8)
    End If
Next
With Sheets("退料单")
   .Range("B7:I35").ClearContents
   .Cells(7, "b").Resize(n, 8) = brr
   .Cells(5, "H") = x
   '.[B6].Resize(n + 1, UBound(brr, 2)).Borders.LineStyle = 1
   '.PrintOut
End With
With Sheets("出库单")
   .Range("B9:I53").ClearContents
   .Cells(9, "b").Resize(n, 8) = crr
   .Cells(7, "H") = Z
   '.[B6].Resize(n + 1, UBound(brr, 2)).Borders.LineStyle = 1
'.PrintOut
End With
Next y
  'MsgBox "OK!"
End Sub

huweifVB

Sub 批量打印出库单和退料单()     Dim arr, i, j     With Sheets("待处理")         arr = .Range("A2:O" & .Range("I" & Rows.Count).End(xlUp).Row)     End With     With Sheets("待处理")         For i = 1 To UBound(arr)                 .Cells(2, "K") = arr(i, 9)             Call 出库退库         Next i     End With End Sub Sub 出库退库()     Dim arr, drr, i, y, c, n, x     With Sheets("待处理")         drr = .Range("G2:O" & .Range("K" & Rows.Count).End(xlUp).Row)     End With    m = Sheets("出入库记录").Cells(Rows.Count, 1).End(3).Row    arr = Sheets("出入库记录").Range("a1:i" & m)     With Sheets("出入库记录")        Trr = .Range("a1:i" & .Range("A" & Rows.Count).End(xlUp).Row)     End With ReDim brr(1 To UBound(Trr), 1 To 8), crr(1 To UBound(arr), 1 To 8) For y = 1 To UBound(drr)  For i = 2 To UBound(arr)     If arr(i, 2) & arr(i, 9) = "D生产领料" & drr(y, 5) Then     Z = arr(i, 1)         c = c + 1         crr(c, 1) = arr(i, 3)         crr(c, 2) = arr(i, 4)         crr(c, 3) = arr(i, 5)         crr(c, 4) = arr(i, 6)         crr(c, 5) = arr(i, 7)         crr(c, 6) = arr(i, 8)     End If Next For T = 2 To UBound(Trr)     If Trr(T, 2) & Trr(T, 9) = "C生产退料" & drr(y, 5) Then     x = Trr(T, 1)         n = n + 1         brr(n, 1) = Trr(T, 3)         brr(n, 2) = Trr(T, 4)         brr(n, 3) = Trr(T, 5)         brr(n, 4) = Trr(T, 6)         brr(n, 5) = Trr(T, 7)         brr(n, 6) = Trr(T, 8)     End If Next With Sheets("退料单")    .Range("B7:I35").ClearContents    .Cells(7, "b").Resize(n, 8) = brr    .Cells(5, "H") = x    '.[B6].Resize(n + 1, UBound(brr, 2)).Borders.LineStyle = 1    .PrintOut End With With Sheets("出库单")    .Range("B9:I53").ClearContents    .Cells(9, "b").Resize(c, 8) = crr    .Cells(7, "H") = Z    '.[B6].Resize(n + 1, UBound(brr, 2)).Borders.LineStyle = 1   '.PrintOut End With Next y   'MsgBox "OK!" End Sub

huweifVB

Sub 批量打印出库单和退料单()
    Dim arr, i, j
    With Sheets("待处理")
        arr = .Range("A2:O" & .Range("I" & Rows.Count).End(xlUp).Row)
    End With
    With Sheets("待处理")
        For i = 1 To UBound(arr)
                .Cells(2, "K") = arr(i, 9)
            Call 出库退库
        Next i
    End With
End Sub
Sub 出库退库()
    Dim arr, drr, i, y, c, n, x
    With Sheets("待处理")
        drr = .Range("G2:O" & .Range("K" & Rows.Count).End(xlUp).Row)
    End With
   m = Sheets("出入库记录").Cells(Rows.Count, 1).End(3).Row
   arr = Sheets("出入库记录").Range("a1:i" & m)
    With Sheets("出入库记录")
       Trr = .Range("a1:i" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
ReDim brr(1 To UBound(Trr), 1 To 8), crr(1 To UBound(arr), 1 To 8)
For y = 1 To UBound(drr)
For i = 2 To UBound(arr)
    If arr(i, 2) & arr(i, 9) = "D生产领料" & drr(y, 5) Then
    Z = arr(i, 1)
        c = c + 1
        crr(c, 1) = arr(i, 3)
        crr(c, 2) = arr(i, 4)
        crr(c, 3) = arr(i, 5)
        crr(c, 4) = arr(i, 6)
        crr(c, 5) = arr(i, 7)
        crr(c, 6) = arr(i, 8)
    End If
Next
For T = 2 To UBound(Trr)
    If Trr(T, 2) & Trr(T, 9) = "C生产退料" & drr(y, 5) Then
    x = Trr(T, 1)
        n = n + 1
        brr(n, 1) = Trr(T, 3)
        brr(n, 2) = Trr(T, 4)
        brr(n, 3) = Trr(T, 5)
        brr(n, 4) = Trr(T, 6)
        brr(n, 5) = Trr(T, 7)
        brr(n, 6) = Trr(T, 8)
    End If
Next
With Sheets("退料单")
   .Range("B7:I35").ClearContents
   .Cells(7, "b").Resize(n, 8) = brr
   .Cells(5, "H") = x
   '.[B6].Resize(n + 1, UBound(brr, 2)).Borders.LineStyle = 1
   .PrintOut
End With
With Sheets("出库单")
   .Range("B9:I53").ClearContents
   .Cells(9, "b").Resize(c, 8) = crr
   .Cells(7, "H") = Z
   '.[B6].Resize(n + 1, UBound(brr, 2)).Borders.LineStyle = 1
  '.PrintOut
End With
Next y
  'MsgBox "OK!"
End Sub
用笨方法处理好了