根据条件，提取对应数据，急需，谢谢大神！

liang870811

我们的城市病了，我作为志愿者，希望我们的城市好起来。

言归正传，目前我负责的是数据核对和上报，意思是，实验室出了结果后，需要根据实验室提供的异常试管编号，在数据库中，把对应的被采集人找出来，然后上报给社区，从而快速的复查和判定相关人员，每天的工作量很大，耗时长而且有时候还会出错。
恳求大神帮帮忙，能否实现批量操作，希望达到的效果如下：
1、一次性输入所有试管编号，在提供的样表的A列，找出所有符合的数据，并且选中A列-T列的所有信息
2、根据试管编号，分不同的工作表，并以试管编号为名称。
样表我已上传，样表中的工作表就是希望达到的效果，谢谢大神的支援！

gwjkkkkk

请参考附件，不知是不是这个意思。。。

liang870811

gwjkkkkk 发表于 2022-11-26 14:01
请参考附件，不知是不是这个意思。。。

不是一键全部归类，而是点击按钮后输入根据实验室提供的样品管编号（实验室只提供异常的试管编号，我的工作表是全部数据的样本），对符合条件数据的建立工作表（如果能建立工作簿最好），谢谢了

liang870811

gwjkkkkk 发表于 2022-11-26 14:01
请参考附件，不知是不是这个意思。。。

不是一键全部分类，而是点击按钮后，输入需要的试管编号，进行筛选，然后再把筛选出来的分类建工作表，谢谢了

gwjkkkkk

请参考 。。。

liang870811

gwjkkkkk 发表于 2022-11-26 15:12
请参考 。。。

谢谢，真的大大提高了效率，替家乡人民谢谢您，祝您工作顺利，万事如意

limonet

代码在审核。

limonet

Sub DataSplit()
    Dim Arr As Variant, i%
    Dim Cn As Object, StrCn$, StrSQL$
    Arr = Split(InputBox("请输入试管编号,用@分隔开", "试管编号"), "@")
    Set Cn = CreateObject("ADODB.Connection")
    StrCn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    Cn.Open StrCn
    For i = 0 To UBound(Arr)
        Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Arr(i)
        StrSQL = "Select * From [App采样信息$A3:T] Where 样品管编号='" & Arr(i) & "'"
        Range("A1").CopyFromRecordset Cn.Execute(StrSQL)
    Next i
End Sub

liang870811

limonet 发表于 2022-11-26 16:12
代码在审核。

谢谢大神的帮忙，你这个更便捷，可以一次性输入多个插叙内容