用于将row1从多个工作表和多个文件编译到预定义工作簿的VBA代码

Question

我有大约15个工作簿，每个工作簿大约有5000张，单元格为“A1”到“Z1”数据。我需要将所有这些工作表编译成一个名为'compiled'的文件。

简单地说，15个xlsm文件中每张表有一行数据。所有这些行都需要编译成一张表。

然而，挑战是在15个工作簿中的每个工作表的单元格“A1”中包含代码编号，例如“12345A”，“B1”包含一些数据，“C1”包含一些数据。

某些工作表共享“A1”，“B1”，“C1”数据。因此，当从这些工作表复制数据时，VBA代码需要检查是否已经复制了具有该“A1”，“B1”，“C1”数据的行，并且仅将“D1”复制到该特定行下面的“AB1”。

样本表

示例编译

SELECT a.*, b.*, Case When a.[Desconto Total] >= b.[Desconto Total] then 'Greater than or equal to previous Month' else 'Less than previous month' End as [Comparison]
FROM SalesMonth(10, 2001) a
left join SalesMonth(9,2001) b
on a.ProductId = b.ProductId

Answer 1

玩得开心：P

Private Sub this()
    Dim path As String, fileName as string
    path = "c:\"
    fileName = Dir(path & "*.xl??")
    dim thisWS as worksheet, sheet as worksheet
    set thisWS = ThisWorkbok.Sheets("Sheet1")
    dim thatWB as workbook
    dim arr(75000) as string
    dim counter as long
    counter = 0
    Do While Len(fileName)>0
        Set thatWB = WorkBooks.Open(path & fileName, True, true)
            For Each sheet in thatWB.Sheets
                arr(counter) = thatWB.sheet.Range("A1").Value
            next sheet
        counter = counter + 1
        thatWB.close Flase
        fileName = Dir()
    Loop
    thisWS.Range(thisWS.Cells(1,1), thisWS.Cells(coutner,1).Value2 = arr
End Sub