求助多条件查询

无涯wbb

公司要求历年历史价格汇总,并做核价
核价过程中,要根据品名,品牌,材质,规格来查找对应的历史价进行比对

历史数据较多,查找的量大,所以只上传了部分数据
希望论坛里的朋友可以帮帮忙,先谢谢了

LMY123

ado加数组，多薄单表

无涯wbb

LMY123 发表于 2018-10-15 14:13
ado加数组，多薄单表

ADO数据库不会建表和关联查询~版主有方法吗

LMY123

无涯wbb 发表于 2018-10-15 15:06
ADO数据库不会建表和关联查询~版主有方法吗

Sub ADO法_单夹_多薄_多表_合并_无标题行_参考()
    Dim Fso As Object, Folder As Object, arr$(), m&, cnn As Object, SQL$, i&
    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(0).ClearContents
    ReDim brr(1 To 10)
    For i = 1 To m
           n = UBound(Split(arr(i), "\"))
           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 * from [" & s & "A2:CT]"
                        Range("A1048576").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 cnn = Nothing
    Set File = Nothing
    Set Fso = 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 "*.xlsx" Then
                m = m + 1
                ReDim Preserve arr(1 To m)
                arr(m) = File
            End If
        Next
'    End If
'    For Each SubFolder In Folder.SubFolders
'        Call GetFiles(SubFolder, arr, m)
'    Next
End Sub
另外，我不是版主，也没能力当版主

无涯wbb

LMY123 发表于 2018-10-15 17:26
Sub ADO法_单夹_多薄_多表_合并_无标题行_参考()
    Dim Fso As Object, Folder As Object, arr$(), m& ...

非常感谢老师的帮助