如何将数据批量查询并复制粘贴到另外一个sheet表里，并满足打印要求

wangmin111 · 发表于 2024-8-20 22:01

1、C2单元格里填数据源里客户的名称；
2、样品名称列里填数据源里对应客户的商品名称，检测结果里填对应结果
3、一个客户的检测报告单尽量打印在一页上，如果数据太多要打印两页以上，A1:G4和A23:G25范围的内容固定都要在每个页面上;
4、所有的检测报告单都建立在一个sheet表里

limonet · 发表于 2024-8-21 10:40

关键字：rst.eof

limonet · 发表于 2024-8-21 10:40

Sub limonet()
Dim Cn As Object, StrSQL$, Rst As Object, Arr As Variant, Brr As Variant, i%, F$
Set Cn = CreateObject("Adodb.Connection")
Set Rst = CreateObject("Adodb.RecordSet")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
Brr = Cn.Execute("Select Distinct 客户名称 From [数据源$]").GetRows
F = "Select 商品名称,'农药残留（有机磷及氨基甲酸酯）' As 检测项目,'GB/T 5009.199-2003' As 判定依据,'' as 空,'＜50%' As 判定标准,iif(结果 is Null,0,结果) From [数据源$] Where 客户名称='"
For i = 0 To UBound(Brr, 2)
      Range("B5:G25") = Null
      [C2] = Brr(0, i): StrSQL = F & Brr(0, i) & "'": If Rst.State = 1 Then Rst.Close
      Rst.Open StrSQL, Cn, 1, 3
      If Rst.RecordCount > 18 Then
         Do Until Rst.EOF
            Arr = Application.Transpose(Rst.GetRows(18))
            Range("B5").Resize(UBound(Arr), 6) = Arr
            'ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
            Range("B5:G25") = Null
         Loop
      Else
         Range("B5").CopyFromRecordset Rst
         'ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
      End If
Next i
End Sub

wangmin111 · 发表于 2024-8-21 11:24

limonet 发表于 2024-8-21 10:40
关键字：rst.eof

老师，运行完后是检测报告单是空的是什么原因呢

limonet · 发表于 2024-8-21 11:27

看代码，打印完就清空，循环下一次数据；反之，下一次数据少于这次就会遗留。

wangmin111 · 发表于 2024-8-21 11:32

limonet 发表于 2024-8-21 11:27
看代码，打印完就清空，循环下一次数据；反之，下一次数据少于这次就会遗留。

可以不清空，这个运行完后还需要留电子档，并且想核查一下在手动打印，这种情况的话，需要怎么调整代码呢

limonet · 发表于 2024-8-21 11:38

题目是：满足打印要求，已经满足了。

wangmin111 · 发表于 2024-8-21 14:19

limonet 发表于 2024-8-21 11:38
题目是：满足打印要求，已经满足了。

好的，谢谢

wangmin111 · 发表于 2024-8-21 14:35

还有其他老师可以帮忙再提供一下代码吗，谢谢了

abc123281 · 发表于 2024-8-21 18:05

wangmin111 发表于 2024-8-21 14:35
还有其他老师可以帮忙再提供一下代码吗，谢谢了

工作簿123.rar (108.08 KB, 下载次数: 10)

		自动登录	找回密码
密码			免费注册

[求助] 如何将数据批量查询并复制粘贴到另外一个sheet表里，并满足打印要求

评分

评分