求助，明细数量是超过表格设置的30行的数量，如何分页

xinlan55

详情见附件，2019-08的明细数量是超过表格设置的30行的数量。O1选择月份。 分页.rar (32.98 KB, 下载次数: 8)

2020-5-4 15:39 上传

点击文件名下载附件

补充内容 (2020-5-8 16:50):
已经弄好  编辑不了主题了，只能在这里补充一下，谢谢大家~
弄好的附件在6楼

笑着...两年过去

上传一下文件嘛，

lby85

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$O$1" Then Exit Sub
    Dim rng1 As Range, rng2 As Range, cl As Range, m&, n&, x&, y&, s#
    With Sheets("数据")
        Range("a7:k1000").ClearContents
        Range("a45:k1000").Borders.LineStyle = 0
        
        
        menu_line = 6
        Page_sn = 1
        kkk = menu_line
        
        For i = 2 To .[b65536].End(3).Row
        Debug.Print i
            If .Cells(i, 2).Value = [O1].Value Then
                kkk = kkk + 1
                Cells(kkk, "b") = .Cells(i, "c").Value
                Cells(kkk, "c") = .Cells(i, "d").Value
                Cells(kkk, "d") = .Cells(i, "e").Value
                Cells(kkk, "e") = .Cells(i, "f").Value
                Cells(kkk, "f") = .Cells(i, "g").Value
                Cells(kkk, "g") = .Cells(i, "h").Value
                Cells(kkk, "h") = .Cells(i, "i").Value
                Cells(kkk, "i") = .Cells(i, "j").Value
                Cells(kkk, "j") = .Cells(i, "k").Value
                Cells(kkk, "k") = .Cells(i, "l").Value
                s = s + Cells(kkk, "l")
               

            
            
            
            
            
            If kkk = menu_line + 30 Then

            Page_sn = Page_sn + 1
            
            
            
            Cells(kkk + 2, "b").PageBreak = xlPageBreakManual
            
            Range(Cells(kkk + 4, "b"), Cells(kkk + 7, "k")).Merge
            
            Cells(kkk + 4, "b").Value = "月入库明细"

            Cells(kkk + 4, "b").HorizontalAlignment = xlCenter
            Cells(kkk + 4, "b").VerticalAlignment = xlCenter
            Cells(kkk + 4, "b").Font.Bold = True
            
            
            
            
            
            
            Cells(kkk + 8, "b") = "月份：" & Sheets("套打").[O1]
        
            Cells(kkk + 8, "k") = "        " & "第" & Page_sn & "页"
            
            
            menu_line = kkk + 10
            Cells(menu_line + 31, "b") = "打印日期：" & Date
            
            
            Cells(menu_line, "b") = "供应商"
            Cells(menu_line, "c") = "存货编码"
            Cells(menu_line, "d") = "存货名称"
            Cells(menu_line, "e") = "规格型号"
            Cells(menu_line, "f") = "数量"
            Cells(menu_line, "g") = "计量单位"
            Cells(menu_line, "h") = "单价"
            Cells(menu_line, "i") = "金额"
            Cells(menu_line, "j") = "备注"
            
            Range(Cells(menu_line, "b"), Cells(menu_line + 30, "k")).Borders.Weight = xlThin
            
            kkk = menu_line
            
            End If
            
            End If
            
        Next
        [B37] = "打印日期：" & Date
        [B4] = "月份：" & Sheets("套打").[O1]
        [K4] = "        " & "第1页"
        
        
    End With
End Sub

lby85

不知道为啥，一直发不了
效果就这样

lby85

代码还没审核过，我再发一下
------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$O$1" Then Exit Sub
    Dim rng1 As Range, rng2 As Range, cl As Range, m&, n&, x&, y&, s#
    With Sheets("数据")
        Range("a7:k1000").ClearContents
        Range("a45:k1000").Borders.LineStyle = 0
  
        menu_line = 6
        Page_sn = 1
        kkk = menu_line
        
        For i = 2 To .[b65536].End(3).Row
        Debug.Print i
            If .Cells(i, 2).Value = [O1].Value Then
                kkk = kkk + 1
                Cells(kkk, "b") = .Cells(i, "c").Value
                Cells(kkk, "c") = .Cells(i, "d").Value
                Cells(kkk, "d") = .Cells(i, "e").Value
                Cells(kkk, "e") = .Cells(i, "f").Value
                Cells(kkk, "f") = .Cells(i, "g").Value
                Cells(kkk, "g") = .Cells(i, "h").Value
                Cells(kkk, "h") = .Cells(i, "i").Value
                Cells(kkk, "i") = .Cells(i, "j").Value
                Cells(kkk, "j") = .Cells(i, "k").Value
                Cells(kkk, "k") = .Cells(i, "l").Value
                s = s + Cells(kkk, "l")

            If kkk = menu_line + 30 Then

            Page_sn = Page_sn + 1

            Cells(kkk + 2, "b").PageBreak = xlPageBreakManual
            
            Range(Cells(kkk + 4, "b"), Cells(kkk + 7, "k")).Merge
            
            Cells(kkk + 4, "b").Value = "月入库明细"

            Cells(kkk + 4, "b").HorizontalAlignment = xlCenter
            Cells(kkk + 4, "b").VerticalAlignment = xlCenter
            Cells(kkk + 4, "b").Font.Bold = True
            
            
            
            
            
            
            Cells(kkk + 8, "b") = "月份：" & Sheets("套打").[O1]
        
            Cells(kkk + 8, "k") = "        " & "第" & Page_sn & "页"
            
            
            menu_line = kkk + 10
            Cells(menu_line + 31, "b") = "打印日期：" & Date
            
            
            Cells(menu_line, "b") = "供应商"
            Cells(menu_line, "c") = "存货编码"
            Cells(menu_line, "d") = "存货名称"
            Cells(menu_line, "e") = "规格型号"
            Cells(menu_line, "f") = "数量"
            Cells(menu_line, "g") = "计量单位"
            Cells(menu_line, "h") = "单价"
            Cells(menu_line, "i") = "金额"
            Cells(menu_line, "j") = "备注"
            
            Range(Cells(menu_line, "b"), Cells(menu_line + 30, "k")).Borders.Weight = xlThin
            
            kkk = menu_line
            
            End If
            
            End If
            
        Next
        [B37] = "打印日期：" & Date
        [B4] = "月份：" & Sheets("套打").[O1]
        [K4] = "        " & "第1页"
        
        
    End With
End Sub

xinlan55

已经弄好 谢谢大家 现在附上弄好的附件