求助,多个表格中取值并汇总在一个表格里,很苦恼~~

bg2216453

不同月份的文件夹里面，需要调取某一个产品对应的多个数据，很是苦恼。
因为论坛附件限制，只能上传部分，还有大量类似的文件夹需要操作，忘大神能帮忙，不胜感激。

bg2216453

论坛大神帮帮忙吧，看了很多VBA的帖子，底子差，还是摸不到头绪。

LMY123

bg2216453 发表于 2018-10-14 17:19
论坛大神帮帮忙吧，看了很多VBA的帖子，底子差，还是摸不到头绪。

加购数是什么？已知条件是什么？

bg2216453

LMY123 发表于 2018-10-14 17:41
加购数是什么？已知条件是什么？

表格有一个“加购件数”，就是加购数，感谢大神回复。

abc123281

汇总结果要求没有讲清楚    不是很明白   你敷衍对待   大家也只能敷衍了事

bg2216453

abc123281 发表于 2018-10-14 18:12
汇总结果要求没有讲清楚    不是很明白   你敷衍对待   大家也只能敷衍了事

可能是我没有说清楚，只需要提取出对应产品的对应参数即可，在下载的文件里面，有一个汇总表，里面我有例举，可能文字表述有点问题……不好意思。
文件夹里有多个表格，表格里有很多产品的不同参数，我需要在汇总表里找到该产品对应的几个参数罗列出来即可，不需要求和或者计算，仅仅只需要罗列出来。
文件夹有每天的30个，每个数据表包含四百多个产品，我需要其中某个产品3-4个参数。
不知道这样表述能不能讲清楚……

yxbaju

不知道要汇总什么，你可以手工做一个汇总，把汇总的逻辑还有需求言简意赅的说明一下，论坛的大神们可以很轻松的帮你搞定，而且你也不需要上传那么多表，搞两个有代表性的有特征的说明下就行了，建议你重新上传个附件，很快就会有热心人回复你的！

Q526753064

bg2216453 发表于 2018-10-14 18:22
可能是我没有说清楚，只需要提取出对应产品的对应参数即可，在下载的文件里面，有一个汇总表，里面我有例 ...

举例子说明一下，然后标注出每个数据的来源

bg2216453

yxbaju 发表于 2018-10-14 18:26
不知道要汇总什么，你可以手工做一个汇总，把汇总的逻辑还有需求言简意赅的说明一下，论坛的大神们可以很轻 ...

好的好的，我重新弄一下

LMY123

bg2216453 发表于 2018-10-14 18:42
好的好的，我重新弄一下

Sub ADO法_多夹_多薄_首表_多条件查询_无标题行_参考()
    Dim arr$(), m&
    Set Fso = CreateObject("Scripting.FileSystemObject"): Set Folder = Fso.GetFolder(ThisWorkbook.Path)
    Application.ScreenUpdating = False
    Call GetFiles(Folder, arr, m)
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;HDR=NO';data source=" & arr(1)
    ActiveSheet.UsedRange.Offset(2).ClearContents
    For i = 1 To m
           Set rs = cnn.OpenSchema(20)
            Do Until rs.EOF
                If rs.Fields("TABLE_TYPE") = "TABLE" Then
                    s = Replace(rs("TABLE_NAME").Value, "'", "")
                    If Right(s, 1) = "$" Then
                        SQL = "select F7,F23,F18,F12 from [A5:AD] WHERE F2*1= " & Split(Range("a1"), "(")(0) & " "
                        Range("a65536").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
                        SQL = "select F7,F23,F18,F12 from [A5:AD] WHERE F2*1= " & Split(Range("E1"), "(")(0) & " "
                        Range("E65536").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
                    End If
                End If
                rs.MoveNext
            Loop
    Next
    Set Folder = Nothing: Set Fso = Nothing: cnn.Close:
    Set Fso = Nothing: Set File = Nothing: Set cnn = Nothing
    Application.ScreenUpdating = True
End Sub
Sub GetFiles(ByVal Folder As Object, arr$(), m&)
    Dim SubFolder As Object
    Dim File As Object
    If Folder.Path <> ThisWorkbook.Path Then
        For Each File In Folder.Files
            If File.Name Like "*.xls*" Then
                m = m + 1
                ReDim Preserve arr(1 To m)
                arr(m) = File
            End If
        Next
    End If
    For Each SubFolder In Folder.SubFolders
       N = UBound(Split(SubFolder, "\"))
       If (Split(Split(SubFolder, "\")(N), "年")(0) = 2017 _
And Val(Split(Split(Split(SubFolder, "\")(N), "月")(0), "年")(1)) > 8) _
Or (Split(Split(SubFolder, "\")(N), "年")(0) = 2018 _
And Val(Split(Split(Split(SubFolder, "\")(N), "月")(0), "年")(1)) < 2) Then
            Call GetFiles(SubFolder, arr, m)
        End If
    Next
End Sub