自学资料（Excel VBA）[收集整理3]

45、自定义函数
Public Function Now1()
Dim string1 As String
string1 = VBA.Date
Now1 = string1
End Function
46、复制
Sub copy1()
Sheet2.Range("C5:C10").Copy Sheet1.Range("C5:C10")
End Sub
47、如何统计表中sheet的个数？
msgbox sheets.count
Columns("G:G").Select
48、 Selection.EntireColumn.Hidden = True
这样隐藏有个毛病，如何解决？如果A1:G1单元格合并的话，就把A：G列均隐藏了。
Columns("G:G").EntireColumn.Hidden = True
49、在VBA中引用excel函数的方法
1). Worksheets("Sheet1").Range("A1").Formula = "=$A$4+$A$10"
2). Sheet1.Cells(1,1).Formula = "=" & Sheets(iii).Name & "!R1C4"
在宏中用R1C1方式写时表格1的A1中会在写为“=Sheet2!$D$1”
用这种方式,想用什么函数就用什么函数.
50、选定下（上）一个工作表
sheets(activesheet.index-1).select
sheets(activesheet.index+1).select
51、Private Sub Workbook_Open()
ActiveWindow.DisplayWorkbookTabs = False '取消工作表标签
Application.CommandBars("Sheet").Controls(1).Enabled = False '格式＿工作表不能重命名
Application.CommandBars.FindControl(ID:=889).Enabled = False '右键菜单不能重命名
End Sub
52、 [a65536].End(xlUp’A列从下往上第一个非空的单元格
53、Sub macro()
Set rng = Range("C11:F13") 定义RNG为一个单元格区域
For Each cel In rng 定义CEL为RNG中的一个任一单元格
colo = cel.Interior.ColorIndex 定义 COLO 为单元格CEL的填充颜色
If colo <> -4142 Then 如果COLO的值不等于-4142
iR = [b65536].End(xlUp).Row + 1 IR等于B列数据区域的行数+1
If [a65535].End(xlUp).Value <> Cells(cel.Row, 2) Then Cells(iR, 1) = Cells(cel.Row, 2)
如果A列最后一个非空值单元格不等于Cells(cel.Row, 2) 的值那么单元格Cells(iR, 1) 的值等于Cells(cel.Row, 2) 的值 CEL.ROW是C11:F13中任意单元格的行号
Cells(iR, 2) = Cells(10, cel.Column)
Cells(iR, 3) = cel.Value
Cells(iR, 4) = IIf(colo = 36, "Yellow", "Red") Cells(iR, 4) 的值如果colo = 36那么值为"Yellow",否则值为"RED"
next
End Sub
54、Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'**********运行数据日志记录**********
Dim rng As Range
If ActiveSheet.Name <> "主界面" And ActiveSheet.Name <> "目录索引" Then
For Each rng In Target.Cells
Changecell = ActiveSheet.Name & "，单元格：" & rng.Address(0, 0) & "，更改为：" & rng.value & "。更改时间：" & Now
CritOrAddtext
Next
End If
End Sub
55、ActiveSheet.Unprotect '撤销当前工作表保护
If ActiveSheet.Name <> "主界面" And ActiveSheet.Name <> "目录索引" And Target.Row > 3 Then '行变色
On Error Resume Next
[ChangColor_With].FormatConditions.Delete
Target.EntireRow.Name = "ChangColor_With"
With [ChangColor_With].FormatConditions
.Delete
.Add xlExpression, , "TRUE"
.Item(1).Interior.ColorIndex = 4
End With
End If
ActiveSheet.Protect
56、在C1中弄个下拉无表,实际是有效性,你可以选择A1:A4为C1单元格有效性的序列数据源,如果说C1不与A1:A4在同一表,则不能这么用,应当先对A1:A4命名,然后把数据源改为名称.
57、自动增加工作表
进入宏命令编辑窗口，在Sub 自动增加工作表()命令后依次键入如下宏命令内容：
Dim i&, userinto
i = 0
userinto = InputBox("输入插入工作表数量：")
If IsNumeric(userinto) = True Then
Do Until i = userinto
Worksheets.Add
i = i + 1
Loop
End If
End Sub
58、方法一（共享级锁定）:
1、先对EXCEL文件进行一般的VBAProject”工程密码保护。
2、打开要保护的文件，选择：工具--->保护--->保护并共享工作簿--->以追踪修订方式共享-->输入密码-->保存文件。
完成后，当你打开“VBAProject”工程属性时，就将会提示：“工程不可看！“
方法二（推荐，破坏型锁定）：
用16进制编辑工具，如WinHex、Ultraedit-32（可到此下载）等，再历害点的人完全可以用debug命令来做......用以上软件打开EXCEL文件，查找定位以下地方：
ID="{00000000-0000-0000-0000-000000000000}" 注：实际显示不会全部为0
此时，你只要将其中的字节随便修改一下即可。保存再打开，就会发现大功告成！
当然，在修改前最好做好你的文档备份。至于恢复只要将改动过的地方还原即可（只要你记住了呵呵）。
顺便说一句，这种方法仍然是可破解的，因为加密总是相对的。
59、Sub AddComments()
'自動對ActiveSheet所有有公式格位加上註解
Set RG = Cells.SpecialCells(xlCellTypeFormulas)
For Each c In RG
c.AddComment
c.Comment.Text Text:=c.Formula
Next c
End Sub
Sub De_Comments()
'自動消除所有註解
Set RG = Cells.SpecialCells(xlCellTypeFormulas)
For Each c In RG
c.ClearComments
Next c
End Sub
60、如何在Excel里使用定时器
www.aspsky.net 2002-3-12 20:53:27 动网先锋
用过 Excel 97 里的加载宏 "定时保存" 吗？可惜它的源程序是加密的，现在就上传一篇介绍实现它的文档。
在 Office 里有个方法是 application.ontime ，具体函数如下：
expression.OnTime(EarliestTime, Procedure, LatestTime, Schedule)
如果想进一步了解，请参阅 Excel 的帮助。
这个函数是用来安排一个过程在将来的特定时间运行，（可为某个日期的指定时间，也可为指定的时间段之后）。通过这个函数我们就可以在 Excel 里编写自己的定时程序了。下面就举两个例子来说明它。
1.在下午 17:00:00 的时候显示一个对话框。
Sub Run_it()
Application.OnTime TimeValue("17:00:00"), "Show_my_msg"
'设置定时器在 17:00:00 激活，激活后运行 Show_my_msg 。
End Sub
Sub Show_my_msg()
msg = MsgBox("现在是 17:00:00 ！", vbInformation, "自定义信息")
End Sub
2.模仿 Excel 97 里的 "自动保存宏",在这里定时 5 秒出现一次
Sub auto_open()
MsgBox "欢迎你，在这篇文档里，每 5 秒出现一次保存的提示！", vbInformation, "请注意！"
Call runtimer '打开文档时自动运行
End Sub
Sub runtimer()
Application.OnTime Now + TimeValue("00:00:05"), "saveit"
' Now + TimeValue("00:15:00") 指定在当前时间过 5 秒钟开始运行 Saveit 这个过程。
End Sub
Sub SaveIt()
msg = MsgBox("朋友，你已经工作很久了，现在就存盘吗？" & Chr(13) _
& "选择是：立刻存盘" & Chr(13) _
& "选择否：暂不存盘" & Chr(13) _
& "选择取消：不再出现这个提示", vbYesNoCancel + 64, "休息一会吧！")
'提示用户保存当前活动文档。
If msg = vbYes Then ActiveWorkbook.Save Else If msg = vbCancel Then Exit Sub
Call runtimer '如果用户没有选择取消就再次调用 Runtimer
End Sub
以上只是两个简单的例子，有兴趣的话，可以利用 Application.Ontime 这个函数写出更多更有用的定时程序。
Sub Show_my_msg()
msg = MsgBox("现在是 17:00:00 ！", vbInformation, "自定义信息")
End Sub
2.模仿 Excel 97 里的 "自动保存宏",在这里定时 5 秒出现一次
Sub auto_open()
MsgBox "欢迎你，在这篇文档里，每 5 秒出现一次保存的提示！", vbInformation, "请注意！"
Call runtimer '打开文档时自动运行
End Sub
Sub runtimer()
Application.OnTime Now + TimeValue("00:00:05"), "saveit"
' Now + TimeValue("00:15:00") 指定在当前时间过 5 秒钟开始运行 Saveit 这个过程。
End Sub