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

使用VBA直接获取Ecxel细胞

1 个答案: