打印签字表

princece

如何打印签字表

百佳

Sub dayin()
    Dim a%, b%, m%, n%
    a = 2 '定义从表格的序号顺数第二行开始
    b = 1 '第一个列开始
    m = 1 '序号初始值
    n = 2 '表2的名单起始行
    Dim Arng, Brng
    Brng = Sheet2.UsedRange
    With Sheet1
        .Range("b5:j34").ClearContents
        Arng = Sheet1.Range("b4:j34")
        t = Range("l5")
        If t = "" Then
            MsgBox ("请先选择单位")
            Exit Sub
        End If
        irow = UBound(Brng)
        For i = 1 To UBound(Brng, 2) '查找单位所在的列
            If Brng(1, i) = t Then tcol = i
        Next
        For i = 1 To irow
            If Brng(n, tcol) = "" Then
                Exit For
            End If
            Arng(a, b + 1) = Brng(n, tcol)
            Arng(a, b) = m
            b = b + 3
            If b > 7 Then
                b = 1 '判断序号所在的列，如果大于7，则周期性变化为1
                a = a + 1 '下一行
            End If
            m = m + 1
            n = n + 1
            If n > irow Then
                a = a - 1
                Exit For
            End If
        Next
        .Cells(4, 2).Resize(a, 9) = Arng
    End With
End Sub

百佳

Sub dayin()
    Dim a%, b%, m%, n%
    a = 2 '定义从表格的序号顺数第二行开始
    b = 1 '第一个列开始
    m = 1 '序号初始值
    n = 2 '表2的名单起始行
    Dim Arng, Brng
    Brng = Sheet2.UsedRange
    With Sheet1
        .Range("b5:j34").ClearContents
        Arng = Sheet1.Range("b4:j34")
        t = Range("l5")
        If t = "" Then
            MsgBox ("请先选择单位")
            Exit Sub
        End If
        irow = UBound(Brng)
        For i = 1 To UBound(Brng, 2) '查找单位所在的列
            If Brng(1, i) = t Then tcol = i
        Next
        For i = 1 To irow
            If Brng(n, tcol) = "" Then
                Exit For
            End If
            Arng(a, b + 1) = Brng(n, tcol)
            Arng(a, b) = m
            b = b + 3
            If b > 7 Then
                b = 1 '判断序号所在的列，如果大于7，则周期性变化为1
                a = a + 1 '下一行
            End If
            m = m + 1
            n = n + 1
            If n > irow Then
                a = a - 1
                Exit For
            End If
        Next
        .Cells(4, 2).Resize(a, 9) = Arng
    End With
End Sub