如果根据条件，把数据表的数据写入另外的工作表

wmwbc

这个是数据，根据可可k2:p2的条件，写入后面两个花名册的模板，并自动根据标准进行填写汇总，花名册的模板只能是15行数据，多余的就要自动增加模板和写入数据，并保持2个花名册打印在一张A4上。

3190496160

Sub 查询打印()
Application.ScreenUpdating = False
Dim ar As Variant
Dim arr()
With Sheets("在校学生数据")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:i" & r)
    nj = .[k2]
    bj = .[l2]
    zx = .[m2]
    zzx = .[n2]
    xq = .[o2]
    xx = .[p2]
    bz = .[q2]
End With
ReDim arr(1 To UBound(ar), 1 To 4)
For i = 2 To UBound(ar)
    If VBA.Trim(ar(i, 5)) = VBA.Trim(nj) And VBA.Trim(ar(i, 6)) = VBA.Trim(bj) And VBA.Trim(ar(i, 8)) = VBA.Trim(zx) And VBA.Trim(ar(i, 9)) = VBA.Trim(zzx) Then
        n = n + 1
        For j = 2 To 4
            arr(n, j - 1) = ar(i, j)
        Next j
        arr(n, 4) = ar(i, 7)
    End If
Next i
If n = "" Then MsgBox "没有符合条件的数据！": End
With Sheets("营养餐花名册")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs >= 30 Then .Rows("30:" & rs).Delete
    .Range("b5:m19") = Empty
    If n <= 15 Then
        .[b5].Resize(n, 4) = arr
        .[b2] = bj
        For i = 5 To n + 4
            For j = 6 To 10
                .Cells(i, j) = bz
            Next j
            .Cells(i, 11) = bz * 5
        Next i
    ElseIf n > 15 Then
        If Int(n / 15) = n / 15 Then
            gs = n / 15
        Else
            gs = Int(n / 15) + 1
        End If
        m = 30
        For i = 1 To gs - 1
            .Rows("1:29").Copy .Cells(m, 1)
            m = m + 29
        Next i
        m = 5
        For i = 1 To n Step 15
            xh = m - 1
            .Cells(m - 1, 2) = bj
            For s = i To i + 14
                If s <= n Then
                    xh = xh + 1
                    For j = 1 To 4
                        .Cells(xh, j + 1) = arr(s, j)
                    Next j
                    For j = 6 To 10
                        .Cells(xh, j) = bz
                    Next j
                    .Cells(xh, 11) = bz * 5
                End If
            Next s
            m = m + 29
        Next i
    End If
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

营养餐花名册.rar (35.34 KB, 下载次数: 27)

2022-12-21 13:12 上传

点击文件名下载附件

wmwbc

3190496160 发表于 2022-12-21 13:12

在帮我重新完善一下这个花名册，最后的金额合计大小写没有，查询条件改变后结果不对

ykcbf1100

wmwbc 发表于 2022-12-21 14:58
在帮我重新完善一下这个花名册，最后的金额合计大小写没有，查询条件改变后结果不对

先送花，再提新的求助。

wmwbc

大哥，新用户，没有鲜花

wmwbc

但是还是感谢大哥

3190496160

wmwbc 发表于 2022-12-21 14:58
在帮我重新完善一下这个花名册，最后的金额合计大小写没有，查询条件改变后结果不对

你自己认真看看你设置的条件吧，在写代码的过程中就感觉，这个设置似乎是在误导帮你的人，
究竟需要的是什么，还需不需要年那个设置，你自己先弄清楚再说吧，

3190496160

wmwbc 发表于 2022-12-21 15:07
大哥，新用户，没有鲜花

注册了5年会员的新人，

nicleyuan

3190496160 发表于 2022-12-21 15:38
注册了5年会员的新人，

这话太伤人了。