求助，如何实现跨工作簿提取数据？

金樽邀月

本人初学VBA，业务不熟，请老师指导，十分感谢。具体要求在附件中。

zpy2

select colIndex[0:8] from consolidateSheet where regexp('\d+',f03)

【在线sql-多表合并-行列筛选数据清洗-哔哩哔哩】 https://b23.tv/qSMgAXmhttps://b23.tv/qSMgAXm

peteryhr

Sub Run()
    Dim filePath$, fileName$, i%, j%, startRow&, 商品编码&, 进价&, arr, sht As Worksheet, Dic As Object
    filePath = Application.ActiveWorkbook.path & "\供货商\"
    fileName = Dir(filePath)
    Do
        Set Dic = CreateObject("Scripting.Dictionary")
        Workbooks.Open (filePath & fileName)
        For Each sht In Worksheets
            商品编码 = 0: 进价 = 0
            arr = sht.UsedRange
            For i = 1 To UBound(arr)
                For j = 1 To UBound(arr, 2)
                    If arr(i, j) = ThisWorkbook.Sheets(1).Range("C2").Value Then
                        商品编码 = j
                        startRow = i + 1
                    End If
                    If arr(i, j) = "单价" Then 进价 = j
                Next
            Next
            If 商品编码 <> 0 Then
                For i = startRow To UBound(arr)
                    If arr(i, 商品编码) <> "" Then Dic(arr(i, 商品编码)) = arr(i, 进价)
                Next
            End If
            With ThisWorkbook.Sheets(1)
                For i = 3 To .Cells(Rows.Count, 3).End(xlUp).Row
                    If Dic.exists(.Cells(i, 3).Value) Then
                        .Cells(i, 8) = Dic(.Cells(i, 3).Value)
                        .Cells(i, 10) = Split(fileName, ".")(0)
                    End If
                Next
            End With
        Next
        Workbooks(filePath & fileName).Close False
        fileName = Dir
    Loop Until fileName = ""
    MsgBox "提取进价完毕！"
End Sub

peteryhr

你自己可以加上禁止屏幕刷新的代码更好一些

peteryhr

前期偷懒只完成了基础要求。发一个完全符合需求完善后的代码