VBA编程问答(第2辑)

VBA编程问答
(第2辑)
在学习ExcelVBA编程的过程中，经常会遇到一些问题，有些可能是新碰到的，有些则是以前已遇到过但暂时忘掉了解决办法的，VBA编程问答将把我所收集到的问题和自已所遇到的问题及解决办法进行归纳整理，以方便查阅和参考。
在下面的内容中，有大量的程序代码，并附有简单的说明，您可以将它们输入或复制到VBE编辑器中进行调试，也可以将它们进行适当的调整和修改后应用到自已的程序中。有些问答提供了参考示例，您可以直接下载后处理。
本辑目录
问题14：如何确定一列中带有数据的最后一个单元格？
问题15：如何将一个组合框中的项目筛选至另一个组合框中？(不使用组合框)
问题16：如何将一个组合框中的项目筛选至另一个组合框中？(使用组合框)
问题17：如何允许用户去选择一个文件夹或者目录？
问题18：如何查找应用工作表公式后出现错误的单元格？
问题19：如何查找工作表中的最后一行？
问题20：如何定位某个特定的单元格为屏幕左上角的单元格？
问题21：如何添加自定义工具条？
问题22：在执行Application.Quit命令后，如何避免出现保存警告信息框？
问题23：如何确定单元格背景颜色的名称或者索引号？
问题24：如何查找两个值之间的值？
问题25：如何在一个单元格区域获取两个给定数值之间的最大数值？
=====================================================================
问题14：如何确定一列中带有数据的最后一个单元格？
解答：这里编写了一个通用函数，您可以调用，从而返回您指定的列中的最后单元格。
‘***********************************
Function LastRowInColumn(intCol As Integer) As Integer
On Error GoTo LRICError
Application.Volatile '确保工作表发生变化时调用该函数
‘通用代码Rows.Count表示工作表行数
LastRowInColumn = Cells(Rows.Count, intCol).End(xlUp).Row
ExitFnxn:
Exit Function
'如果出错,则返回错误值到最后的单元格中
LRICError:
LastRowInColumn = CVErr(xlErrNA)
Resume ExitFnxn
End Function
‘***********************************
您可以在工作表中输入以下测试代码对上面的函数进行测试。
‘***********************************
Sub test()
Dim X As Integer
‘指定确定第2列中的最后一个单元格
X = LastRowInColumn(2)
Debug.Print X
End Sub
‘***********************************
示例文档见(问题14)确定某列中的最后单元格.xls。Va6xE4Ih.rar (8.02 KB)
Va6xE4Ih.rar (8.02 KB)
[原创]VBA编程问答(第2辑)
下载次数: 21
2006-8-3 15:29
此外，运行下面的代码将允许用户使用Windows对话框选择一个文件：
‘***********************************
Sub test()
Dim Filename
Filename = Application.GetOpenFilename()
End Sub
‘***********************************
GetOpenFilename是一个内置的Excel函数，它仅返回一个文件名。您必须采取读取文件的操作。
===================================================================
问题18：如何查找应用工作表公式后出现错误的单元格？
解答：下面是一个很方便使用的程序，用于查找在工作表中应用公式后出现错误值的单元格并选中。
‘***********************************
Sub FindErrors()
‘如果没有在工作表中发现错误，将会产生错误
On Error Goto FEError
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors).Select
Exit Sub
FEError:
MsgBox "没有发现错误", , "提示!"
Exit Sub
End Sub
‘***********************************
===================================================================
问题19：如何查找工作表中的最后一行？
解答：下面是一个快速且简单的函数，用于获取工作表中含有数据的最后一行。
‘***********************************
Function GetLastRow(SheetID) As Integer
Dim LastRow As Integer
If Application.WorksheetFunction.CountA(Worksheets(SheetID).Cells) = 0 Then
LastRow = 1
Else
LastRow = Worksheets(SheetID).UsedRange.Rows.Count + Worksheets(SheetID).UsedRange.Row
While Application.WorksheetFunction.CountA(Worksheets(SheetID).Rows(LastRow)) = 0
LastRow = LastRow - 1
Wend
End If
GetLastRow = LastRow
End Function
‘***********************************
您可以使用简单的语句进行测试，在代码模块中输入如下代码：
‘***********************************
Sub test()
Dim I As Long
I=GetLastRow(1)
Debug.Print i
End Sub
‘***********************************
运行上述过程后，将会在立即窗口中显示当前工作簿中工作表1中最后一行的行号。
===================================================================
问题20：如何定位某个特定的单元格为屏幕左上角的单元格？
解答：可以通过滚动行和滚动列来实现：
‘***********************************
'定位工作表中的单元格M14在屏幕左上角
Sub test()
Worksheets(1).Select
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollColumn = 13
End Sub
‘***********************************
也可以使用以下语句实现：
‘***********************************
'定位工作表中的单元格G10在屏幕左上角
Sub test()
Application.GoTo Range("G10"), True
End Sub
===================================================================
 
附件
G8HPPtYF.rar (6.4 KB)
2006-8-3 15:27, 下载次数: 28
[原创]VBA编程问答(第2辑)
6ZCNf7Wc.rar (10.82 KB)
2006-8-3 15:28, 下载次数: 23
[原创]VBA编程问答(第2辑)
uCmzz1fI.rar (9.51 KB)
2006-8-3 15:28, 下载次数: 25
[原创]VBA编程问答(第2辑)
嵌入式框架页展示Excel视频教程，包括Excel函数公式、Excel VBA图表应用技巧、Excel教程下载与免费在线学习培训。 资料库http://fanjy.blog.excelhome.net
博客网http://www.excelperfect.com
UID
13913
帖子
902
精华
11
经验
2109
威望
17
阅读权限
100
性别
男
在线时间
99 小时
查看个人网站
查看详细资料
引用使用道具报告回复 TOP
fanjy

版主

积分
8009
财富
4733 ￥
技术
117
注册时间
2003-3-19
总积分排名
55
发短消息
加为好友
2楼 大 中 小 发表于 2006-8-3 15:34 只看该作者
★《精粹》中的精粹：成为Excel高手的捷径★        ★《循序渐进学Excel》视频教程免费教您起步★

<续>
问题21：如何添加自定义工具条？
解答：下面是添加自定义工具条的示例代码，运行该代码后将在“标准”工具条的右侧出现一个名为“我的工具条”的自定义工具条，与Excel的内置工具条一样，您可以移动/悬浮它，并且单击工具条里的命令可以执行相应的操作。当然，如果您愿意的话，可以将本示例扩展，添加一些有用的命令在自定义的工具条上，从而扩展Excel的功能。
本示例中，该工具条是临时的，当您关闭工作簿后，它不会保存。您最好在在Workbook_Open事件中调用”AddToolbar”程序，这样当打开该工作簿时，自动添加自定义的工具条。
‘***********************************
Sub AddToolBar()
Dim cmdbar As CommandBar
Dim CmdBtn1 As CommandBarButton
Dim strTBName As String
strTBName = "我的工具条"
'如该工具条已经存在则不再添加
If CheckForToolbar(strTBName) Then Exit Sub
Set cmdbar = CommandBars.Add(Name:=strTBName, Position:=msoBarTop, Temporary:=True)
cmdbar.Visible = True
With cmdbar
'放置该工具条在“标准”工具条的右侧
.Left = CommandBars("Standard").Width
.RowIndex = CommandBars("Standard").RowIndex
Set CmdBtn1 = .Controls.Add(msoControlButton, , , , True)
With CmdBtn1
.Style = msoButtonCaption
.Caption = "我的工具条"
.TooltipText = "这是一个示例工具条."
.OnAction = "HelloWorld"
End With
End With
Set cmdbar = Nothing
Set CmdBtn1 = Nothing
End Sub
‘***********************************
Function CheckForToolbar(argName As String) As Boolean
Dim bar As CommandBar, Result As Boolean
Result = False
For Each bar In CommandBars
If bar.Name = argName Then
Result = True
End If
Next bar
CheckForToolbar = Result
End Function
‘***********************************
Sub HelloWorld()
MsgBox "Hello World!"
End Sub
‘***********************************
示例文档见(问题21)添加工具条示例.xls。5wLhrNrS.rar (8.26 KB)
5wLhrNrS.rar (8.26 KB)
[原创]VBA编程问答(第2辑)
下载次数: 16
2006-8-3 15:32
===================================================================
 
附件
crbwQo4l.rar (8.87 KB)
2006-8-3 15:31, 下载次数: 26
[原创]VBA编程问答(第2辑)
5wzRotbA.rar (9.38 KB)
2006-8-3 15:32, 下载次数: 22
[原创]VBA编程问答(第2辑)
8eFVMiLf.rar (7.26 KB)
2006-8-3 15:33, 下载次数: 24
[原创]VBA编程问答(第2辑)
资料库http://fanjy.blog.excelhome.net
博客网http://www.excelperfect.com
UID
13913
帖子
902
精华
11
经验
2109
威望
17
阅读权限
100
性别
男
在线时间
99 小时
查看个人网站
查看详细资料
引用使用道具报告回复 TOP
fanjy

版主

积分
8009
财富
4733 ￥
技术
117
注册时间
2003-3-19
总积分排名
55
发短消息
加为好友
3楼 大 中 小 发表于 2006-8-3 15:35 只看该作者
★ 好帖推荐、申请精华或加分、违规帖举报，欢迎“报告”，报告有奖！★
<续>
问题24：如何查找两个值之间的值？
解答：在Excel和大多数的MS Office应用程序中，有一个“查找”功能可用来在一个范围、工作表或工作簿中查找特定的值、或者文本字符串。然而，没有一个用于查找在两个值之间(指定的最大值和最小值)之间第一次出现某个值的位置的功能，我们能使用VBA代码来处理。代码如下：
‘***********************************
Sub GetBetween()
Dim strNum As String
Dim lMin As Long, lMax As Long
Dim rFound As Range, rLookin As Range
Dim lFound As Long, rStart As Range
Dim rCcells As Range, rFcells As Range
Dim lCellCount As Long, lcount As Long
Dim bNoFind As Boolean
strNum = InputBox("请先输入最大值,然后输入逗号," _
& "接着输入最大值" & vbNewLine & _
vbNewLine & "例如: 1,10", "输入最小值和最大值")
If strNum = vbNullString Then Exit Sub
On Error Resume Next
lMin = Left(strNum, InStr(1, strNum, ","))
If Not IsNumeric(lMin) Or lMin = 0 Then
MsgBox "输入数据错误, 或者最小值不应为零", vbCritical
Exit Sub
End If
lMax = Replace(strNum, lMin & ",", "")
If Not IsNumeric(lMax) Or lMax = 0 Then
MsgBox "输入数据错误,或者最大值不应为零", vbCritical
Exit Sub
End If
If lMax < lMin Then
MsgBox "最小值大于最大值", vbCritical
Exit Sub
End If
If lMin + 1 = lMax Then
MsgBox "最大值和最小值之间没有范围", vbCritical
Exit Sub
End If
If Selection.Cells.Count = 1 Then
Set rCcells = Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
Set rFcells = Cells.SpecialCells(xlCellTypeFormulas, xlNumbers)
Set rStart = Cells(1, 1)
Else
Set rCcells = Selection.SpecialCells(xlCellTypeConstants, xlNumbers)
Set rFcells = Selection.SpecialCells(xlCellTypeFormulas, xlNumbers)
Set rStart = Selection.Cells(1, 1)
End If
'缩小查找范围
If rCcells Is Nothing And rFcells Is Nothing Then
MsgBox "工作表无数据", vbCritical
Exit Sub
ElseIf rCcells Is Nothing Then
Set rLookin = rFcells.Cells '公式
ElseIf rFcells Is Nothing Then
Set rLookin = rCcells.Cells '常量
Else
Set rLookin = Application.Union(rFcells, rCcells) '公式和常量
End If
lCellCount = rLookin.Cells.Count
Do Until lFound > lMin And lFound < lMax And lFound > 0
lFound = 0
Set rStart = rLookin.Cells.Find(What:="*", After:=rStart, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
lFound = rStart.Value
lcount = lcount + 1
If lCellCount = lcount Then
bNoFind = True
Exit Do
End If
Loop
rStart.Select
If bNoFind = True Then
MsgBox "没有数据在" _
& lMin & " 和 " & lMax & "之间", vbInformation
End If
On Error GoTo 0
End Sub
‘***********************************
该代码将以工作表中“查找”功能相同的方式工作，当仅选择一个单元格时，将在所有单元格中查找；当选择一部分单元格时，仅在所选单元格区域中查找，在两个值之间的符合条件的第一个单元格被选中，不包含最小值和最大值本身。注意，本程序代码不会查找零值。
例如，在工作表中有1至10共10个数据，若您要查找3至5之间的数据，运行后在对话框中输入3,5，内容为4的单元格将被选中。
示例文档见(问题24)查找最大最小值之间的值.xls。[attach]167320[/attach]
By fanjy in 2006-8-3
资料库http://fanjy.blog.excelhome.net
博客网http://www.excelperfect.com
UID
13913
帖子
902
精华
11
经验
2109
威望
17
阅读权限
100
性别
男
在线时间
99 小时
查看个人网站
查看详细资料
引用使用道具报告回复 TOP
fanjy

版主

积分
8009
财富
4733 ￥
技术
117
注册时间
2003-3-19
总积分排名
55
发短消息
加为好友
4楼 大 中 小 发表于 2006-8-3 15:41 只看该作者
★你以前不知道的Word：《Word实战技巧精粹》视频教程★

附:VBA编程问答总目录
 
 
第1辑问题1：如何优化VBA代码并使程序尽可能快的运行？问题2：如何传递参数到OnTime方法和OnAction属性所调用的宏程序中？问题3：如何禁用用户窗体的关闭按钮？问题4：可以撤销宏所执行的操作吗？问题5：如何将同一文件夹中的多个文本文件读入到工作簿中？问题6：如何使用VBA删除所有的空工作表？问题7：如何获取计算机上可供使用的打印机列表？问题8：如何基于某个单元格更新其它单元格的日期？问题9：如何编写一个宏程序运行另一个宏程序特定的次数？问题10：如何在一个组合框中列出所有工作表中单元格D3中的值？问题11：如何使工作表中的文本闪烁？问题12：如何将工作簿中其它工作表名导入到指定的工作表中？问题13：如何在单元格中快速输入带秒的时间？
第2辑问题14：如何确定一列中带有数据的最后一个单元格？问题15：如何将一个组合框中的项目筛选至另一个组合框中？(不使用组合框)问题16：如何将一个组合框中的项目筛选至另一个组合框中？(使用组合框)问题17：如何允许用户去选择一个文件夹或者目录？问题18：如何查找应用工作表公式后出现错误的单元格？问题19：如何查找工作表中的最后一行？问题20：如何定位某个特定的单元格为屏幕左上角的单元格？问题21：如何添加自定义工具条？问题22：在执行Application.Quit命令后，如何避免出现保存警告信息框？问题23：如何确定单元格背景颜色的名称或者索引号？问题24：如何查找两个值之间的值？ 问题25：如何在一个单元格区域获取两个给定数值之间的最大数值？