[分享]VBA程序集(第5辑)

fanjy

刚整理的VBA程序,供参考.

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。 RqmLWpOI.rar (7.26 KB, 下载次数: 673)

2006-7-1 17:25 上传

点击文件名下载附件
[分享]VBA程序集(第5辑)

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

 

By fanjy in 2006-7-1

[此贴子已经被作者于2006-7-1 17:26:48编辑过]

plxmm

谢谢分享。

jasoncaib

谢谢分享

hiyou

使用方法部分不作评论

对函数提一些改进意见

1。 数据输出() 部分

DestFile = InputBox(...) 这一段，建议改成

DESfILe=application.GetSaveAsFilename(...) 或 DESfile=application.GetOpenFilename(...)

这部分前天正好跟版上几位朋友讨论过

（参见http://club.excelhome.net/viewthread.php?tid=174486&replyID=&skin=0  可乐虫、爱歌学习、tall等讨论）

我查了一下，GetSaveAsFilename和GetOPenFilename两个方法从在OFF97就开始提供的，其中前者可以直接初始化路径

另外，函数说明是对数据输出，代码部分却改成SELECTION，不是很般配，而且限制了函数的适用范围，健壮性也有问题，就是当SELECTION不是RANGE时，这个函数其实不能起作用，靠ON ERROR跳过去了。

我建议是这样，将声明改成

SUB 数据输出（rngSelect as RANGE) 

由用户决定输入的范围，比如他可以这样使用

数据输出 activesheet.usedrange

或这样用

数据输出 RANGE（"A1:D1000")

诸如此类，灵活得多了

[此贴子已经被作者于2006-7-1 21:24:35编辑过]

fanjy

使用方法部分不作评论

对函数提一些改进意见

1。 数据输出() 部分

DestFile = InputBox(...) 这一段，建议改成

DESfILe=application.GetSaveAsFilename(...) 或 DESfile=application.GetOpenFilename(...)

这部分前天正好跟版上几位朋友讨论过

（参见http://club.excelhome.net/viewthread.php?tid=174486&replyID=&skin=0  可乐虫、爱歌学习、tall等讨论）

我查了一下，GetSaveAsFilename和GetOPenFilename两个方法从在OFF97就开始提供的，其中前者可以直接初始化路径

另外，函数说明是对数据输出，代码部分却改成SELECTION，不是很般配，而且限制了函数的适用范围，健壮性也有问题，就是当SELECTION不是RANGE时，这个函数其实不能起作用，靠ON ERROR跳过去了。

我建议是这样，将声明改成

SUB 数据输出（rngSelect as RANGE) 

由用户决定输入的范围，比如他可以这样使用

数据输出 activesheet.usedrange

或这样用

数据输出 RANGE（"A1:D1000")

诸如此类，灵活得多了

谢谢您对程序的评论.其实这些程序只是用的其中一种方法.VBA程序的一个特点就是,一个功能可以用好多种方法来实现.当然,方法有优有劣.可以对程序进行优化或调整.

程序名是我自已临时起的,可能表达不是很完美,但在前面的说明部分我已经说明过了.

至于Input函数和MsgBox函数与GetSaveAsFilename和GetOPenFilename方法,各有优劣,各随喜好.可能不久,我会总结一篇文章,就它们的特点进行对比.

可能这里用GetOPenFilename方法更直观一些吧.再次谢谢您对程序的评论.

[此贴子已经被作者于2006-7-1 21:39:06编辑过]

hiyou

2。程序19  统计单元格数，这个，怎么说好呢...（看起来是出自MS的Q213507那个示例吧）

一般的VB集合，都带有Count，Selection是比较标准的集合了，所以，如果只是单纯的统计，FOR EACH NEXT只取COUNT很浪费的样子。建议只要这样就可以

Selection.Count

（不排除遇到没有Count的特殊集合——但是没有Count却支持For Each Next，说明做这个类有_newemu算子，做出这种自定义集合的兄弟也太另类了）

程序19这类代码的统计，个人认为改成演示多维VB数组，或者是演示集合中多重条件统计分类好一些，类似这样：

count1=0

count2=0

for each cell selection

if cell.value="条件1" then count1=count1+1  '<==并不一定要cell.value,也可以是其它属性，可以是函数判断式（用cell做参数）

if cell.value="条件2" then count2=count2+2

next

......

[此贴子已经被作者于2006-7-3 13:37:08编辑过]

Kelidai

谢谢分享。

okmhy

谢谢分享,收藏了![em04]

zbajsgamr

谢谢楼主

yxfeXCEL

谢谢分享,收藏了!