VBA编程——Excel对象模型

VBA可以通过Excel对象模型对Excel应用、工作簿、工作表等进行完全的控制，功能非常强大；而本文侧重于数据的读写操作；通过本文将了解Application、Workbook、Worksheet、Range等对象的应用，并演示了如何根据指定列的内容分解数据。

首先看一个简单的示例，假如在Excel第一个工作表（Sheet1）中有如下图的数据。

数据

下面的代码，将通过VBA代码将Sheet1工作表中的数据复制到“d:\考试成绩.xlsx”文件的新工作表中。

VBA

Sub Main()
    Dim wb, ws
    Set wb = Application.Workbooks.Add()
    Set ws = wb.Worksheets.Add()
    ' 复制数据
    For r = 1 To Sheet1.UsedRange.Rows.Count
        For c = 1 To Sheet1.UsedRange.Columns.Count
            ws.Cells(r, c) = Sheet1.Cells(r, c)
        Next
    Next
    '
    wb.SaveAs ("d:\考试成绩.xlsx")
    wb.Close
End Sub

本例，代码虽然不多，但使用了很多关键的对象操作，下面分别讨论。

首先，wb和ws对象分别为新的工作簿和工作表对象，注意使用Set关键字开始的赋值语句。Application表示Excel应用对象，其中的Workbooks属性表示打开的工作簿集合，使用其中的Add()方法添加一个新的工作簿，返回对象类型为Workbook；Workbook对象的Worksheets属性表示工作簿中的工作表集合对象，使用Add()添加一个新的工作表。

接下来是复制数据，确定工作表中的有效数据区域时使用了工作表对象的UsedRange属性（Range对象），然后分别使用Rows.Count和Columns.Count属性确定有效数据区域的行数和列数，并使用For循环复制了Sheet1工作表的数据。

最后使用工作簿对象（wb）的SaveAs()方法保存工作簿文件，并使用Close方法关闭工作簿对象。

下面介绍一些对象的常用操作。

Application对象

Application对象表Excel应用，下面介绍一些常用的操作。

ActiveWindow属性，获取当前应用窗口。

ActiveWorkbook属性，获取当前工作簿，返回Workbook对象。

ActiveSheet属性，获取当前工作表，返回Worksheet对象。

Cells属性，可以直接调用当前工作表中的单元格集合，可以使用 Cells(rowIndex,colIndex)格式读写单元格内容，其中，参数分别指定行索引和列索引。

Workbooks属性表示打开的工作簿集合对象，常用的方法有：

Add()方法，添加新的工作簿。
Open()方法，打开已存在的工作簿文件。
使用索引可以选中工作簿，并通过Activate方法激活为当前工作簿，如Workbooks("Sheet1").Activate。

Workbook对象

Workbook对象表示工作簿，也就是一个Excel文件；在VBA编辑环境中，可以看到“工程”窗口中有一个ThisWorkbook对象，表示当前工作簿对象，可以在代码中直接调用。

获取Workbook对象时，还可以通过Application对象的Workbooks集合相关方法，如Add()方法新的工作簿、Open()方法打开已存在的Excel文件、使用索引获取指定的工作簿对象等。

下面是Workbook对象的一些常用操作。

ActiveSheet属性，获取当前工作表，返回Worksheet对象。

Path属性，获取Excel文件的路径。

Worksheets属性，获取工作簿中的所有工作表集合。可以使用索引获取指定的工作表，也可以使用Add()方法添加新的工作表。

Close()方法，关闭工作簿。

Save()方法，保存当前打开的工作簿。

SaveAs()方法，将当前工作簿另存为一个新的Excel文件。

Worksheet对象与单元格

Worksheet对象表示工作表，可以通过Application或Workbook对象的ActiveSheet属性获取当前工作表，也可以通过人Workbook对象Worksheets集合的Add()方法添加新的工作表或使用索引获取已存在的工作表。

获取Worksheet对象后，可以通过一系列的方法和属性进行操作，下面来看一些常用的资源。

Name属性可以获取工作表的名称。

Range属性表示工作表中的区域，可以使用一个单元格或两个单元格指定区域范围。

UsedRange属性表示工作表中有效的数据区域，其中，可以使用Rows和Columns属性分别获取区域中的行和列集合。

Cells属性表示工作表中的单元格，可以通过行索引和列索引获取单元格对象。单元格中可以使用Value属性读取或写入单元格数据，也可以直接赋值为单元格内容。如文章开始的示例中，获取单元格对象后，可以直接获取或写入单元格内容。下面的代码，可以在单元格中写入数据和公式。

VBA

Sub Main()
    Sheet1.Cells(1, 1) = 10
    Sheet1.Cells(1, 2) = 99
    Sheet1.Cells(1, 3) = "=a1+b1"
End Sub

执行Main()子程序后，Sheet1工作表内容如下图所示。

使用VBA写入单元格内容

Range对象

Range对象表示一个或多个单元格组成的连续区域，而Area对象则可以包含一个或多个Range区域。获取一个Range对象后，可以使用Merge()方法进行合并单元格操作，如下面的代码。

VBA

Sub Main()
    Dim rng
    Set rng = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, 3))
    rng.Merge
    rng.Value = "表格标题"
End Sub

执行代码会将A1到C1三个单元格合并，并设置内容为“表格标题”。取消单元格合并时可以使用Range对象的UnMerge()方法。

按指定列的内容分解数据

假如在Sheet3工作表中有如下图所示的数据。请注意，这里的数据是标准的二维表格式，且第一行为列名。

分类数据

接下来的工作是将此表的数据按“分类”分别保存到不同的Excel文件中，如A类数据保存到A.xlsx，B类数据保存到B.xlsx文件，C类数据保存到C.xlsx文件。首先，在mComm模块添加下面的代码。

VBA

' 判断一个数据是否在数组中
Function inArray(val As Variant, arr() As Variant) As Boolean
    For Each e In arr
        If e = val Then
            inArray = True
            Exit Function
        End If
    Next
    inArray = False
End Function

' 判断一个值添加到数组中
Function extendArray(val As Variant, ByRef arr() As Variant)
    Dim i As Long
    i = UBound(arr) + 1
    ReDim Preserve arr(i)
    arr(i) = val
End Function

' 按指定列名数据分类并分别保存为不同的文件
' 标准二维表，第一行为列名
Function extractByColumn(ws As Worksheet, colName As String, path As String) As Boolean
    On Error GoTo ErrorLabel
    Dim rowCount, colCount
    rowCount = ws.UsedRange.Rows.Count
    colCount = ws.UsedRange.Columns.Count
    ' 获取分类列的索引
    Dim colIndex
    colIndex = -1
    For i = 1 To colCount
        If ws.Cells(1, i) = colName Then
            colIndex = i
            Exit For
        End If
    Next
    If colIndex = -1 Then
        extractByColumn = False
        Exit Function
    End If
    ' 获取分类数据
    Dim arr()
    ReDim Preserve arr(0)
    arr(0) = ws.Cells(2, colIndex).Value
    For r = 3 To rowCount
        v = ws.Cells(r, colIndex).Value
        If inArray(v, arr) = False Then
            extendArray v, arr
        End If
    Next
    ' 按值分别导出
    For i = LBound(arr) To UBound(arr)
        strFilename = path & "\" & arr(i) & ".xlsx"
        Set wb = Application.Workbooks.Add()
        Set newWs = wb.Worksheets.Add()
        ' 写入列名行
        For c = 1 To colCount
            newWs.Cells(1, c) = ws.Cells(1, c)
        Next
        ' 写入数据
        curRow = 2
        For r = 2 To rowCount
            If ws.Cells(r, colIndex).Value = arr(i) Then
                ' 写入当前行
                For c = 1 To colCount
                    newWs.Cells(curRow, c) = ws.Cells(r, c)
                Next
                curRow = curRow + 1
            End If
        Next
        ' 保存文件
        wb.SaveAs strFilename
        wb.Close
    Next
    '
    extractByColumn = True
    Exit Function
ErrorLabel:
    extractByColumn = False
End Function

代码中定义了三个函数，分别是inArray()、extendArray()和extractByColumn()，下面分别说明。

inArray(val, arr)函数判断val是否存在于arr数组。函数中，使用For Each循环访问arr数组中的所有成员，当存在val时返回True；循环过后，如果arr数组中不存在val元素则返回False。

extendArray(val, arr)函数将val添加到arr数组。请注意arr参数使用了ByRef关键字，其功能是将明确参数按引用传递，这样就可以在函数中实际修改arr数组的内容。

接下来着重来看extractByColumn(ws, colName, path)函数，其功能是在ws工作表中，按colName列的数据分类，并分别保存到path指定的路径中。函数中首先获取了实际数据区域（UsedRange）的行数（rowCount）和列数（colCount）；然后获取了colName所在列的索引（colIndex）；接下来从第2行开始访问一遍colIndex列的数据，并获取了不重复的数据组成的数组（arr），即分类数据；最后按colIndex列中的分类数据（arr数组）分别导出为新的文件，新文件使用分类数据命名。

在模块1中的Main子程序中使用如下代码调用extractByColumn()函数，如下面的代码。

VBA

Sub Main()
    Debug.Print (extractByColumn(Sheet3, "分类", "d:"))
End Sub

执行成功会在“立即窗口”显示True，并在D:盘下添加三个新的文件，即A.xlsx、B.xlsx和C.xlsx，下图显示了C.xlsx文件的内容。

分类导出数据