根据给定的条件打印？？（已解决）

zhaogang1960

请测试:
Private Sub 打印_Click()
    Dim arr(), brr(1 To 18, 1 To 2), c As Range, temp As String, lr As Long
    Dim i As Long, j As Long, m As Integer, n As Integer, firstAddress As String
    temp = [q3]
    If temp = "" Then Exit Sub        'Q3=""则退出程序
    lr = Sheets("登记表").Range("b65536").End(xlUp).Row
    ReDim arr(1 To lr, 1 To 2)
    With Sheets("登记表").Range("b:b")
        Set c = .Find(temp, LookAt:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                m = m + 1
                arr(m, 1) = c.Offset(, 1).Value
                arr(m, 2) = c.Offset(, 2).Value
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
    If m = 0 Then
        MsgBox "没有查到"
        Exit Sub '没有查到Q3则退出程序
    End If
    On Error Resume Next
    If m <= 18 Then
        Range("B7:C24") = ""
        Range("b7").Resize(m, 2) = arr
        ActiveSheet.PrintOut '打印当前工作表
    Else
        For i = 1 To m Step 18
            n = 0
            For j = i To i + 17
                n = n + 1
                brr(n, 1) = arr(j, 1)
                brr(n, 2) = arr(j, 2)
            Next j
            Range("B7:C24") = ""
            Range("b7").Resize(n, 2) = brr
            Erase brr
            ActiveSheet.PrintOut '打印当前工作表
        Next i
    End If
End Sub
巡视记录卡.rar (17.87 KB, 下载次数: 56)

2009-1-1 17:45 上传

点击文件名下载附件

WANGJUN0811

谢谢！谢谢！！两位朋友的帮助！家里没配打印机，明天去单位测试，再次向你们表示衷心的感谢！！！

WANGJUN0811

谢谢Zhangang1960老师！问题解决。

乖小孩

谢谢分享。真的非常实用