vba - 使用 VBA 直接获取 Excel 单元格

Question

我在一个文件夹中有多个 Excel 文件，它们都有固定的模板。我想从中获取单元格，然后放入一个新工作簿。

我以文件夹中的2个Excel文件为例进行说明。我有一个名为 MyFolder 的文件夹和其中的两个Excel文件。 ( file1.xlsx 和 file2.xlsx )





我想要的是这样的:



所以，我尝试了:

Sub Merge_Files()
Dim FSO As New FileSystemObject
Dim xFolder As Folder
Dim xFile As File
Dim Main_WB As Workbook, New_WB As Workbook
Dim X As Integer, Y As Integer
Set Main_WB = ActiveWorkbook
Set xFolder = FSO.GetFolder("C:\Desktop\MyFolder\") 

    Cells(1, "A").Value = "Company"
    Cells(1, "B").Value = "CB"
    Cells(1, "C").Value = "N/R"
    Cells(1, "D").Value = "BB"
    Cells(1, "E").Value = "Contact"
    Cells(1, "F").Value = "BT"
    Cells(1, "G").Value = "TypeAAAUnit"
    Cells(1, "H").Value = "AAAJob1_Max"
    Cells(1, "I").Value = "AAAJob1_Min"
    Cells(1, "J").Value = "AAAJob1_BR50"
    'I omit some parts here.
    Cells(1, "V").Value = "Total P/per person"

For Each xFile In xFolder.Files
    Set New_WB = Workbooks.Open(xFile.Path)
        Main_WB.Sheets(1).Range("A" & X).Value = New_WB.Sheets(1).Range("C1").Value
        Main_WB.Sheets(1).Range("B" & X).Value = New_WB.Sheets(1).Range("C2").Value
        Main_WB.Sheets(1).Range("C" & X).Value = New_WB.Sheets(1).Range("C3").Value
        Main_WB.Sheets(1).Range("D" & X).Value = New_WB.Sheets(1).Range("C4").Value
        Main_WB.Sheets(1).Range("E" & X).Value = New_WB.Sheets(1).Range("C5").Value
        Main_WB.Sheets(1).Range("F" & X).Value = New_WB.Sheets(1).Range("C6").Value
        Main_WB.Sheets(1).Range("G" & X).Value = New_WB.Sheets(1).Range("B11").Value
        Main_WB.Sheets(1).Range("H" & X).Value = New_WB.Sheets(1).Range("D11").Value
        Main_WB.Sheets(1).Range("I" & X).Value = New_WB.Sheets(1).Range("E11").Value
        Main_WB.Sheets(1).Range("J" & X).Value = New_WB.Sheets(1).Range("F11").Value
        Main_WB.Sheets(1).Range("V" & X).Value = New_WB.Sheets(1).Range("O23").Value
        New_WB.Close SaveChanges:=False
    Next xFile
End Sub

但是，它不起作用，所以我修改了我的代码的某些部分。我删除了
Main_WB.Sheets(1).Range("A" & X).Value = New_WB.Sheets(1).Range("C1").Value
并将其更改为:

ActiveCell.Offset(xRow, 0) = xFolder.Sheets(1).Range("C1").Value
ActiveCell.Offset(xRow, 1) = xFolder.Sheets(1).Range("C2").Value
ActiveCell.Offset(xRow, 2) = xFolder.Sheets(1).Range("C3").Value    
'repeat so omit...
xRow = xRow + 1

但是，它仍然不起作用。我想直接获取每个单元格，因为在这两个 Excel 文件中，有很多单元格并且它们不按顺序排列。有什么解决办法吗？

Answer 1

X 需要增加。我还使用 With 语句重构了代码以提高可读性。

Sub Merge_Files()
    Dim FSO As New FileSystemObject
    Dim xFolder As Folder
    Dim xFile As File
    Dim Main_WB As Workbook, New_WB As Workbook
    Dim X As Integer, Y As Integer
    Set Main_WB = ActiveWorkbook

    Set xFolder = FSO.GetFolder("C:\Desktop\MyFolder\")
    X = 1
    With Main_WB.Worksheets(1)
        .Range("A" & X).Value = "Company"
        .Range("B" & X).Value = "CB"
        .Range("C" & X).Value = "N/R"
        .Range("D" & X).Value = "BB"
        .Range("E" & X).Value = "Contact"
        .Range("F" & X).Value = "BT"
        .Range("G" & X).Value = "TypeAAAUnit"
        .Range("H" & X).Value = "AAAJob1_Max"
        .Range("I" & X).Value = "AAAJob1_Min"
        .Range("J" & X).Value = "AAAJob1_BR50"
        .Range("V" & X).Value = "Total P/per person"

        For Each xFile In xFolder.Files
            X = X + 1
            Set New_WB = Workbooks.Open(xFile.Path)
            .Range("A" & X).Value = New_WB.Sheets(1).Range("C1").Value
            .Range("B" & X).Value = New_WB.Sheets(1).Range("C2").Value
            .Range("C" & X).Value = New_WB.Sheets(1).Range("C3").Value
            .Range("D" & X).Value = New_WB.Sheets(1).Range("C4").Value
            .Range("E" & X).Value = New_WB.Sheets(1).Range("C5").Value
            .Range("F" & X).Value = New_WB.Sheets(1).Range("C6").Value
            .Range("G" & X).Value = New_WB.Sheets(1).Range("B11").Value
            .Range("H" & X).Value = New_WB.Sheets(1).Range("D11").Value
            .Range("I" & X).Value = New_WB.Sheets(1).Range("E11").Value
            .Range("J" & X).Value = New_WB.Sheets(1).Range("F11").Value
            .Range("V" & X).Value = New_WB.Sheets(1).Range("O23").Value
            New_WB.Close SaveChanges:=False
        Next xFile

    End With
End Sub