VBA程序集(第5辑)

VBA程序集
(第5辑)

[摘要] VBA程序集汇集了一些小型代码程序。其中的代码可直接运用到您的应用程序中，也可以根据您的需要稍作调整或修改后运用到您的应用程序中。一小段代码也能附加额外的功能或增强现有的功能，或许能大大改善您的工作效率。
本程序集中汇集了5个小型实用功能程序代码：
 >>将Excel数据表输出为一个带有逗号和引号分隔符的文本文件
 >>统计所选区域中包含公式、文本或数字的单元格数
 >>使用Saved属性判断工作簿是否有改变
 >>连接相邻两列单元格中的数据
 >>汇总单元格区域的行单元格值和列单元格值

如何创建和使用这些程序
使用程序前，您必须选创建它。您可以在VBE编辑器中输入或粘贴下面的代码以创建宏程序，然后执行工作表菜单“工具”中的宏程序，或者在工作表中为自定义的菜单或命令按钮附加宏，这样就可以方便使用它们。
1. 打开您想创建宏程序的工作簿或新工作簿。
2. 在工作表中选择菜单“工具——宏——Visual Basic编辑器”(或按Alt+F11组合键)，打开VBE编辑器。
3. 在VBE编辑器中选择菜单“插入——模块”，插入一个模块并打开代码窗口。
4. 在代码窗口中输入或粘贴程序代码。
5. 关闭VBE窗口。
6. 若程序要求运行前需要选择单元格区域或特定单元格，则先按要求选择。
7. 选择工作表菜单“工具——宏——宏”命令，打开“宏”对话框。在“宏”对话框中选择所创建的宏，单击“执行”按钮运行宏程序。
提示  (1) 当然，上面的创建和使用程序的过程不是唯一的，您可以根据习惯来进行，如可以直接在VBE编辑器中运行宏，或者将宏程序附加到自定义菜单或按钮中，点击它们即运行。
      (2) 在阅读或理解这些程序的时候，您应该思考如何扩展这些应用程序来满足您的需要。

程序分析和程序代码
■ 将Excel数据表输出为一个带有逗号和引号分隔符的文本文件
Excel没有一个菜单命令能够自动输出数据到一个文本文件，例如输出为一个带有逗号和引号标记作为分隔符的文本文件。例如，内容为“Text1”，”Text2”，”Text3”的文本文件。
但是，你能在Excel中使用VBA宏程序实现这个功能。在VBA宏程序中使用Print语句，输出一个带有逗号和引号作为分隔符的文本文件。为了实现程序的功能，你必须在运行程序前选择你所有输出为文本文件的数据的单元格区域。
程序代码如下：
****************************
程序18(数据输出)
Option Explicit
Sub 数据输出()
    Dim DestFile As String
    Dim FileNum As Integer
    Dim ColumnCount As Integer
    Dim RowCount As Integer

    ' 提示用户输入目标文件名
    DestFile = InputBox("输入您所要保存数据的目标文件名" & _
      Chr(10) & "(最好带有完整的保存路径和扩展名):", _
      "引号-逗号分隔输出")
    ' 获取下一个文件号
    FileNum = FreeFile()

    ' 忽略出现的错误
    On Error Resume Next

    '打开想要输入数据的目标文件
    Open DestFile For Output As #FileNum
    '若发生错误则结束运行
    If Err <> 0 Then
      MsgBox "不能打开文件!请确保您输入了正确的文件名和路径." & DestFile
      End
    End If

    ' 打开错误检查
    On Error GoTo 0

    ' 查找所选区域中的每一行
    For RowCount = 1 To Selection.Rows.Count
      ' 查找所选区域的每一列
      For ColumnCount = 1 To Selection.Columns.Count

         ' 写当前单元格中的文本并带有引号标记到目标文件中
         Print #FileNum, """" & Selection.Cells(RowCount, _
            ColumnCount).Text & """";
         '检查单元格是否是最后一列中的单元格
         If ColumnCount = Selection.Columns.Count Then
            '如果是,则写入一个空白行
            Print #FileNum,
         Else
            '否则,写入一个逗号
            Print #FileNum, ",";
         End If
      ' 开始下一列循环判断
      Next ColumnCount
    ' 开始下一行循环判断
    Next RowCount

    ' 关闭写入的目标文件
    Close #FileNum
End Sub
****************************
文档示例见[过程]输出所选数据到文本文件.xls。UploadFiles/2006-7/71278799.rar
■ 统计所选区域中包含公式、文本或数字的单元格数
在Excel中，您能使用定位对话框来选取工作表中某单元格区域所包含的公式、文本或数字的单元格，即
1. 在编辑菜单中，单击“定位”，打开“定位”对话框。
2. 单击“定位条件”按钮，打开“定位条件”对话框。为了选择所有的公式，单击公式选项按钮，确保选中数字、文本、逻辑值和错误复选框。若要选择文本，则选取常量选项按钮并只选取公式按钮下的“文本”复选框；若要选择数字，则选取常量选项按钮并只选取公式按钮下的“数字”复选框。
要统计所选区域单元格的数量，并在消息框中显示结果，使用下面的程序：
****************************
程序19(循环)
Option Explicit
Sub 选区单元格数()
    Dim cell As Object
    Dim count As Integer
    count = 0
    For Each cell In Selection
        count = count + 1
    Next cell
    MsgBox "您选择了" & count & "个单元格."
End Sub
****************************
提示  您能在工作表中将该程序指给一个自定义按钮，当您单击此按钮时，将显示您工作表上所选区域单元格数。
示例文档见[过程]统计所选区域的单元格数.xls。UploadFiles/2006-7/71979122.rar
■ 使用Saved属性判断工作簿是否有改变
您能通过检查工作簿的Saved属性判断该工作簿是否发生了改变。根据工作簿是否改变，Saved属性返回True值或False值。
若您的工作表中存在可变函数，可能影响Saved属性判断。可变函数是在工作表中每次发生变化时都重新进行计算的函数，不管该变化是否影响到这个函数。最常用的可变函数有RAND(),NOW(),TODAY()和OFFSET()。
下面是不同条件下该属性的运用代码：
程序20(对工作簿的操作)
****************************
‘当活动工作簿发生改变而没有保存时显示一个消息
Sub 测试1()
    If ActiveWorkbook.Saved = False Then
        MsgBox "这个工作簿已经改变，但您没有保存该变化. "
    End If
End Sub
****************************
‘不保存并关闭工作簿，而不管工作簿是否发生改变
Sub 测试2()
    ThisWorkbook.Saved = True
    ThisWorkbook.Close
End Sub
****************************
‘功能与上面的程序相同，即不管工作簿是否变化，不保存而直接关闭工作簿
Sub 测试3()
    ThisWorkbook.Close SaveChanges:=False
End Sub 
****************************
■ 连接相邻两列单元格中的数据
在Excel中，你能使用一个宏程序来连接两个相邻列中的数据，并在右边相邻的空列显示结果，下面的宏程序实现该功能：
****************************
程序21(单元格)
Sub 连接相邻两列数据()
    '循环直到活动单元格为空
    Do While ActiveCell <> ""
        ActiveCell.Offset(0, 1).FormulaR1C1 = _
           ActiveCell.Offset(0, -1) & " " & ActiveCell.Offset(0, 0)
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub
****************************
提示  在运行程序前，应该将选第二列的第一个单元格作为当前单元格。即若想合并A1：A10和B1：B10中的数据，运行程序前，单元格B1应为活动单元格。
示例文档见[过程]连接相邻两单元格中的数据.xls。UploadFiles/2006-7/71978092.rar
■ 汇总单元格区域的行单元格值和列单元格值
在Excel中，您能使用数组去计算和操作工作表中的数据。你也能使用宏程序在一个数组中存储一个单元格区域中的值。这里介绍的宏程序代码将添加一个附加列和行到一个矩形单元格区域中，并汇总这个区域中每行和每列的列数和行数。
代码首先在活动工作表中从活动单元格所在的单元格区域中读取数据，并存诸数据在数组中，然后对单元格区域中的每行和每列进行统计，最后输出到工作表中。数组的大小取决于当前区域中单元格的数量。
注 该宏程序没有添加任何公式到工作表中，因此，如果所统计区域发生改变，汇总结果不会相应变化，故您必须重新运行宏。
****************************
程序22(数组应用)
Option Explicit
Sub 汇总行列值()
    ' 该程序假设您已在一个矩形单元格区域中选取了单元格
    ' 汇总数据将显示在矩形区域右侧和下面
    Dim r As Integer
    Dim c As Integer
    Dim i As Integer
    Dim j As Integer
    Dim myArray As Variant

   '选取包含所选单格的区域
    With Selection.CurrentRegion
        r = .Rows.Count
        c = .Columns.Count
        '用区域中的行列数定义数组大小
        myArray = .Resize(r + 1, c + 1)

        ' 变量i代表行数,变量j代表列数.
        '当一行循环完后进入下一行
        For i = 1 To r
            For j = 1 To c
              myArray(i, c + 1) = myArray(i, c + 1) + myArray(i, j)
              myArray(r + 1, j) = myArray(r + 1, j) + myArray(i, j)
              myArray(r + 1, c + 1) = myArray(r + 1, c + 1) + myArray(i, j)
            Next j
        Next i

        .Resize(r + 1, c + 1) = myArray
    End With
End Sub
****************************
提示  (1)运行该程序前，应保证活动单元格处于数据区域中。
      (2)您能修改该程序执行相似的操作，例如，对单元格区域进行相减、相乘或相除等数学运算。
示例文档见[过程]汇单元格区域中的行列值.xls。UploadFiles/2006-7/71957932.rar

一点心得
在学习VBA的过程中，注意积累一些实有的小型程序，不仅对提高您的VBA编程水平有所帮助，而且可以在运用时对程序作些小的调整以方便地满足您所需的功能。这些，都绝对是值得做的。