Office Excel VBA编程

 本文涉及到的内容包括VBA数组、从单元格读取值填充二维数组、取excel文件的有效行、多文件合并等内容。

首先，有文件1、文件2、文件3，文件1的名字为"合并.xls"，文件2、文件3等的文件名随意定。但他们的格式需要一致，如下图所示：

 

 

现在，把文件2、文件3的内容合并到合并.xls文件中。由于文件2、文件3等文件的文件名不固定，因此，需要定义二维数组，在数组中动态识别文件名，因此，在合并.xls文件开一个工作表，专门存放文件名，如下所示

 

首先，定义一个数组

Dim MyArr(), MyRng As Range

 

把单元格的内容读入数组，

 Set MyRng = Workbooks("合并.xls").Sheets("Sheet2").Range("A1:B4")
  MyArr = MyRng

 

使用循环，完成从多个文件向一个文件的合并，

打开需要合并的文件

    Workbooks.Open Filename:=xx & MyArr(Filename, 2) & ".xls "

得到需要合并的文件的有效行数（不是Excel的65536行）
    irowTo = ActiveSheet.Range("A65536").End(-4162).Row

设置目标文件为活动文件
    Workbooks("合并.xls").Activate

得到目标文件的有效行数
    irowFrom = ActiveSheet.Range("A65536").End(-4162).Row

 

如果是第一个需要合并的文件，则直接从目标文件的第三行开始粘贴

   If Filename = 1 Then
       Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Range("A3:F" & irowTo).Copy
       Workbooks("合并.xls").Sheets("Sheet1").Range("A3:F" & irowTo).PasteSpecial paste:=xlPasteValues
    Else

 如果不是第一个需要合并的文件，则需要找到上一次粘贴完成后的最后一行，接着往下贴
        a = irowFrom + 1
        b = irowFrom + irowTo - 1
       
        Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Range("A3:F" & irowTo).Copy
        Workbooks("合并.xls").Sheets("Sheet1").Range("A" & a & ":F" & b).PasteSpecial paste:=xlPasteValues
    End If

 

 

完整的程序代码如下：

Sub hebing() Sheets("Sheet1").Range("A3:F5000").ClearContents xx = Workbooks("合并.xls").Path & "/" Dim MyArr(), MyRng As Range Set MyRng = Workbooks("合并.xls").Sheets("Sheet2").Range("A1:B4") MyArr = MyRng For Filename = 1 To UBound(MyArr) Workbooks.Open Filename:=xx & MyArr(Filename, 2) & ".xls " irowTo = ActiveSheet.Range("A65536").End(-4162).Row Workbooks("合并.xls").Activate irowFrom = ActiveSheet.Range("A65536").End(-4162).Row If Filename = 1 Then Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Range("A3:F" & irowTo).Copy Workbooks("合并.xls").Sheets("Sheet1").Range("A3:F" & irowTo).PasteSpecial paste:=xlPasteValues Else a = irowFrom + 1 b = irowFrom + irowTo - 1 Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Range("A3:F" & irowTo).Copy Workbooks("合并.xls").Sheets("Sheet1").Range("A" & a & ":F" & b).PasteSpecial paste:=xlPasteValues End If Workbooks(MyArr(Filename, 2) & ".xls").Close Next Workbooks("合并.xls").Save End Sub

 

如果文件中，存在多个工作表，则不能用这种思路，因为在VBA中，再设置工作薄的当前活动工作表时有BUG，当你设置sheet1为当前活动工作表，取sheet1的当前有效行数，但结果往往不是你想要的sheet1的行数，而是其它表的行数。如果文件存在多表，则可以利用单元格来赋值。直接贴代码上来

Sub hebing1() Sheets("Sheet1").Range("A3:F" & Sheets("Sheet1").Rows.Count).ClearContents xx = Workbooks("合并.xls").Path & "/" Dim MyArr(), MyRng As Range Set MyRng = Workbooks("合并.xls").Sheets("表").Range("A1:B4") MyArr = MyRng irowfrom = 3 For Filename = 1 To UBound(MyArr) Workbooks.Open Filename:=xx & MyArr(Filename, 2) & ".xls " ihang = 3 Do Until Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Cells(ihang, 1).Value = "" ihang = ihang + 1 Loop irowto = ihang For i = 3 To irowto Workbooks("合并.xls").Sheets("Sheet1").Cells(irowfrom, 1).Value = Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Cells(i, 1).Value Workbooks("合并.xls").Sheets("Sheet1").Cells(irowfrom, 2).Value = Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Cells(i, 2).Value Workbooks("合并.xls").Sheets("Sheet1").Cells(irowfrom, 3).Value = Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Cells(i, 3).Value Workbooks("合并.xls").Sheets("Sheet1").Cells(irowfrom, 4).Value = Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Cells(i, 4).Value Workbooks("合并.xls").Sheets("Sheet1").Cells(irowfrom, 5).Value = Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Cells(i, 5).Value Workbooks("合并.xls").Sheets("Sheet1").Cells(irowfrom, 6).Value = Workbooks(MyArr(Filename, 2) & ".xls").Sheets("Sheet1").Cells(i, 6).Value irowfrom = irowfrom + 1 Next irowfrom = irowfrom - 1 Workbooks(MyArr(Filename, 2) & ".xls").Close Next Workbooks("合并.xls").Save End Sub