不同文件下同名工作簿、同名工作表、相同区域汇总

southmaple

求助

在多个文件夹下，都存在同名工作簿——MSRep.xls，在工作簿中均存在一个同名的工作表——QRes。QRes工作表中的，B列、E列的第7行到第11行。如下图中所示，需要汇总到一个指定的工作簿——《GCMS检测结果.xlsm》的工作表《检测结果汇总》中。


检测结果汇总.rar (1013.16 KB, 下载次数: 11)

2019-11-3 16:08 上传

点击文件名下载附件

EXCELLMY

数据规范用ADO ,否则用数组法

southmaple

EXCELLMY 发表于 2019-11-3 16:41
数据规范用ADO ,否则用数组法

我原本自己用pyhon东西拼凑了一段代码，可以有效运行。但是实验室的联机电脑不允许上网，每次都要把数据导来导去的，也嫌麻烦。

以前的汇总都是在同一个文件夹下，在论坛里可以找到直接能用的。简单的VBA代码，我可以理解，ADO、数组之类的我还看不懂。最近在论坛里查了好些个代码，因为不懂ADO，所以没有办法自己进行调整。
import os
import numpy as np
import pandas as pd

# ————————查找目标文件
list_path = []
path = (r'C:\Users\Administrator\Desktop\20190911')
for dirpath,dirnames,filenames in os.walk(path):
    for filename in filenames:
        a = os.path.join(dirpath,filename)
        list_path.append(a)
# print (list_path)

newlist=[]
for i in list_path:
    if "MSR" in i:
        newlist.append(i)
# print (newlist)

# ————————编制序列
x=int(len(newlist))

mainx=np.arange(1,x/2+1,1).repeat(10)
mainx=mainx.reshape([len(mainx),1])
mainx=mainx.tolist()

subx=np.arange(1,3,1).repeat(5)
subx=np.tile(subx,int(x/2))
subx=subx.reshape([len(mainx),1])
subx=subx.tolist()


# ————————提取数据,与序列组合
li = []
for i in newlist:
    li.append(pd.read_excel(i, sheet_name="QRes", skiprows=5))
data = pd.concat(li)
data=data.iloc[:,[1,4]]
data['主序列']=mainx
data['次序列']=subx


writer = pd.ExcelWriter(r'C:\Users\Administrator\Desktop\检测结果.xlsx')
data = data.to_excel(writer, 'Sheet1', index=False)
writer.save()

xiangbaoan

Option Explicit
Sub test()  '既然都有，就不作判断
Dim Cn As Object, Sq$, fd
Sheets("检测结果汇总").Activate
Range("A2:b" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
For Each fd In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\20190911").SubFolders
    Sq = "SELECT 化合物名称,样品量 FROM [Excel 12.0;Database=" & fd.Path & "\MSRep.xls" & "].[QRes$b6:e11]"
    Cells(Rows.Count, 1).End(xlUp).Offset(1).CopyFromRecordset Cn.Execute(Sq)
Next
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True
End Sub

xiangbaoan

………………

southmaple

xiangbaoan 发表于 2019-11-3 17:22
………………

以前用SQL只知道能在一个工作簿的几个工作表间互相查询，原来还能这么使用，受教。

能否再请推荐一本与VBA相关的SQL的学习书籍。

liangmutou01

Dim conn
Sub cs()
  Application.ScreenUpdating = False
  Set conn = CreateObject("ADODB.Connection")
  Sheets("检测结果汇总").Activate
  Range("a2:b65536").ClearContents
  Getfd (ThisWorkbook.Path & "\20190911\")
  Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth)
     Set Fso = CreateObject("scripting.filesystemobject")
     Set ff = Fso.getfolder(pth)
     If ff.Files.Count > 0 Then
       For Each wj In ff.Files
         conn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;HDR=no';data source=" & wj
         Range("a" & Cells(Rows.Count, 1).End(3).Row + 1).CopyFromRecordset _
           conn.Execute("select F1,F4 from [QRes$b7:e11]")
         If conn.State = 1 Then conn.Close
       Next wj
     End If
     If ff.subfolders.Count > 0 Then
       For Each fd In ff.subfolders
         Getfd (fd)
       Next fd
       Set conn = Nothing
     End If
End Sub

liangmutou01

把程序文件一并发给你。

southmaple

liangmutou01 发表于 2019-11-3 18:39
把程序文件一并发给你。

为了方便上传文件，我的每个子文件中只包含中了一个MSRep.xls文件，实际的情况下每个文件夹下都有多个同名的多个文件。
4楼的SQL代码中， Sq = "SELECT 化合物名称,样品量 FROM [Excel 12.0;Database=" & fd.Path & "\MSRep.xls" & "].[QRes$b6:e11]"

即便每个子文件夹下的文件较多，依然可以筛选出我需要的文件并进行汇总。

conn.Execute("select F1,F4 from [QRes$b7:e11]")——是否可以再完善一下。

jjmysjg

留下记号，学习