VBA自学收集.docx
《VBA自学收集.docx》由会员分享，可在线阅读，更多相关《VBA自学收集.docx（65页珍藏版）》请在冰豆网上搜索。
VBA自学收集
自 学 收 集
1、Application.CommandBars（"WorksheetMenuBar"）.Enabled=false
2、cells（activecell.row,"b"）.value'活动单元格所在行B列单元格中的值
3、SubCheckSheet（）'如果当前工作薄中没有名为kk的工作表的话，就增加一张名为kk的工作表，并将其排在工作表从左至右顺序排列的最左边的位置，即排在第一的位置
DimshtSheetAsWorksheet
ForEachshtSheetInSheets
IfshtSheet.Name="KK"ThenExitSub
NextshtSheet
SetshtSheet=Sheets.Add（Before:
=Sheets
（1））
shtSheet.Name="KK"
EndSub
4、Sheet1.ListBox1.List=Array（"一月","二月","三月","四月"）'一次性增加项目
5、Sheet2.Rows
（1）.Value=Sheet1.Rows
（1）.Value'将一个表中的一行全部拷贝到另一个表中
6、Subpro_cell（）'将此代码放入sheet1,则me=sheet1,主要是认识me
Me.Unprotect
Cells.Locked=False
Range（"D11:
E11"）.Locked=True
Me.Protect
EndSub
7、Application.CommandBars（"Ply"）.Enabled=False'工作表标签上快捷菜单失效
8、Subaa（）'把B1到B12单元格的数据填入c1到c12
Fori=1To12
Range（"C"&i）=Range（"B"&i）
Nexti
EndSub
9、ActiveCell.AddComment
Selection.Font.Size=12'在点选的单元格插入批注，字体为12号
10、PrivateSubWorksheet_BeforeDoubleClick（ByValTargetAsRange,CancelAsBoolean）
Cancel=True
EndSub
11、ScrollArea属性
参阅应用于示例特性以A1样式的区域引用形式返回或设置允许滚动的区域。
用户不能选定滚动区域之外的单元格。
String类型，可读写。
说明
可将本属性设置为空字符串（""）以允许对整张工作表内所有单元格的选定。
示例
本示例设置第一张工作表的滚动区域。
Worksheets
（1）.ScrollArea="a1:
f10"
12\ifapplication.max（[a1:
e1]）=10then
msgbox""
commandbutton1.enabled=false
'A1—E1最大的数值达到10时，自动弹出对话框，并冻结按钮
12、本示例将更改的单元格的颜色设为蓝色。
PrivateSubWorksheet_Change（ByValTargetasRange）
Target.Font.ColorIndex=5
EndSub
13、Subtest（）'求和
DimrngAsRange,rng2AsRange
ForEachrngInActiveSheet.UsedRange.Columns
Setrng2=Range（Cells（1,rng.Column）,Cells（Cells（65536,rng.Column）.End（xlUp）.Row,rng.Column））
rng2.Cells（rng2.Cells.Count）.Offset（1,0）=WorksheetFunction.Sum（rng2）
Nextrng
EndSub
14、将工作薄中的全部n张工作表都在sheet1中建上链接
Subtest2（）
DimPtAsRange
DimiAsInteger
WithSheet1
SetPt=.Range（"a1"）
Fori=2ToThisWorkbook.Worksheets.Count
.Hyperlinks.AddAnchor:
=Pt,Address:
="",SubAddress:
=Worksheets（i）.Name&"!
A1"
SetPt=Pt.Offset（1,0）
Nexti
EndWith
EndSub
15、保存所有打开的工作簿，然后退出MicrosoftExcel。
ForEachwInApplication.Workbooks
w.Save
Nextw
Application.Quit
16、让form标题栏上的关闭按钮失效
PrivateSubUserForm_QueryClose（CancelAsInteger,CloseModeAsInteger）
IfCloseMode<>1ThenCancel=True
EndSub
17、Subcountsh（）'获得工作表的总数
MsgBoxSheets.Count
EndSub
18、SubIE（）'打开个人网页
ActiveWorkbook.FollowHyperlink"about:
blank"
SendKeys"{F4}{ENTER}",True
EndSub
19、Subdelback（）'一次性删除工作簿中所有工作表的背景
ForEachshtSheetInSheets
shtSheet.SetBackgroundPictureFilename:
=""
NextshtSheet
EndSub
20、[a1].formula="=b1+c1"'A1中设定公式为=B1+C1
21、PrivateSubCommandButton1_Click（）'将A1到C6中大于=3的数依次放入E列
DimiAsLong
r=1
ForEachiInRange（"a1:
c6"）
Ifi>=3ThenCells（r,5）=i:
r=r+1
Next
EndSub
22、PrivateSubWorkbook_SheetChange（ByValShAsObject,ByValTargetAsRange）'显示带数字的表名
b=Split（Sh.Name,"（"）
OnErrorGoToss
num=CInt（Left（b
（1）,Len（b
（1））-1））
Ifnum>=1Andnum<20Then
MsgBoxSh.Name
EndIf
ExitSub
ss:
MsgBox"error",16,""
EndSub
PrivateSubDTPicker1_Change（）
ActiveCell.Value=DTPicker1.Value
DTPicker1.Visible=False
EndSub
PrivateSubWorksheet_SelectionChange（ByValTargetAsRange）
WithMe.DTPicker1
IfTarget.Column=11AndTarget.Count=1Then
.Visible=True
.Width=Target.Width+15
.Left=Target.Left
.Top=Target.Top
.Height=Target.Height
Else
.Visible=False
EndIf
EndWith
EndSub
23、SubTest（）'选择所有工作表名以"业报"开头的工作表或头两个字是业报的报表名引用
SetSh=ActiveSheet
IfLeft（Sh.Name,2）="业报"Then'或ifsh.namelike"业报*"then
MsgBox"你成功了",64,""
EndIf
EndSub
24、1.建立文件夹的方法
MkDir"D:
\Music"
2.打开文件夹的方法
ActiveWorkbook.FollowHyperlinkAddress:
="D:
\Music",NewWindow:
=True
25、在当前工作表翻页
Application.SendKeys"{PGUP}",True
Application.SendKeys"{PGDN}",True
或者
ActiveWindow.LargeScrollDown:
=1
ActiveWindow.LargeScrollDown:
=-1
26、当Target="*小计"时如何写,*代表任何字符。
ifinstr（target.value,"小计"）<>0then
PrivateSubWorksheet_SelectionChange（ByValTargetAsRange）
IfTarget.ValueLike"*小计"ThenMsgBox"OK"
EndSub
27、ActiveCell.FormulaR1C1="=SUM（R[1]C:
R[14]C,R[59]C:
R[78]C）"
这是相对引用的写法：
根据推算你的函数是放在“AD6”单元格
你的函数：
=SUM（R[1]C:
R[14]C 中的 "R"表示行 "C"表示列。
R[1]表示“AD6+1行"，C表示“列没有变化，就是同列”那么：
R[1]C就表示AD7
同理，R[14]表示AD6+14行，表示：
AD20。
以此类推。
28、PrivateSubCommandButton1_Click（）'将A1到C6中大于=3的数依次放入E列
DimiAsLong
DimiRngAsRange
ForEachiRngInSheets
（1）.Range（"a1:
c6"）
IfiRng.Value>=3Then
i=i+1
Sheets
（1）.Range（"E"&i）.Value=iRng.Value
EndIf
Next
EndSub
29、工作表中的窗体按钮禁用后，按钮形状不变，字体不变，从外表上无法看出其已禁用，如何设置属性使其像控件按纽那样明显的禁用？
WithActiveSheet.Buttons
（1）
.Enabled=False
ActiveSheet.Shapes（.Caption）.DrawingObject.Font.ColorIndex=15
EndWith
復原的方法
WithActiveSheet.Buttons
（1）
.Enabled=True
ActiveSheet.Shapes（.Caption）.DrawingObject.Font.ColorIndex=xlAutomatic
EndWith
30、PrivateSubWorksheet_SelectionChange（ByValTargetAsRange'选定A1时要输入密码
IfTarget.Address="$A$1"Then
A=InputBox（"请输入密码","officefans"）
IfA=1Then[A1].SelectElse[A2].Select
EndIf
EndSub
31、如何将工作薄中的命名单元格成批删除！
DimItemAsName
ForEachItemInActiveWorkbook.Names
Item.Delete
NextItem
32、平时只能看到表1，如要看表2和表3，只能通过表1的链接打开,且表2和表3回到表1后，又不可见。
PrivateSubWorksheet_SelectionChange（ByValTargetAsRange）
IfTarget.Address="$A$3"Then '当点击"$A$3"单元格时...
Sheet2.Visible=1 '取消隐藏
Sheet2.Activate'激活
ActiveSheet.Range（"A1"）.Select
EndIf
IfTarget.Address="$A$6"Then
Sheet3.Visible=1 '取消隐藏
Sheet3.Activate
ActiveSheet.Range（"A1"）.Select
EndIf
EndSub
33、将a2单元格内容替换为a1内容
ActiveCell.ReplaceWhat:
=[a2],Replacement:
=[a1]
34、如果是要填入名称,则:
PrivateSubWorksheet_SelectionChange（ByValTargetAsRange）
Selection.Value=ComboBox1.column
（1）
EndSub
如果是要填入代码和名称的组合:
PrivateSubWorksheet_SelectionChange（ByValTargetAsRange）
Selection.Value=cstr（ComboBox1.column（0））+""+combobox1.column
（1）
EndSub
PrivateSubWorksheet_SelectionChange（ByValTargetAsRange）
Selection.Value=ComboBox1.Value
EndSub
PrivateSubWorksheet_SelectionChange（ByValTargetAsRange）
'target.row 代表行号
'target.column代表列号
i=target.row '获取行号
j=target.column'获取列号
EndSub
35、当激活工作表时，本示例对A1:
A10区域进行排序。
PrivateSubWorksheet_Activate（）
Range（"a1:
a10"）.SortKey1:
=Range（"a1"）,Order:
=xlAscending
EndSub
36、BeforePrint事件
参阅应用于示例特性在打印指定工作簿（或者其中的任何内容）之前，产生此事件。
PrivateSubWorkbook_BeforePrint（CancelAsBoolean）
Cancel 当事件产生时为False。
如果该事件过程将本参数设为True，则当该过程运行结束之后不打印工作簿。
示例
本示例在打印之前对当前活动工作簿的所有工作表重新计算。
PrivateSubWorkbook_BeforePrint（CancelAsBoolean）
ForEachwkinWorksheets
wk.Calculate
Next
EndSub
37、Open事件
参阅应用于示例特性打开工作簿时，将产生本事件。
PrivateSubWorkbook_Open（）
示例
每次打开工作簿时，本示例都最大化MicrosoftExcel窗口。
PrivateSubWorkbook_Open（）
Application.WindowState=xlMaximized
EndSub
38、ActiveSheet属性
参阅应用于示例特性返回一对象，该对象代表活动工作簿中的，或者指定的窗口或工作簿中的活动工作表（最上面的工作表）。
只读。
如果没有活动的工作表，则返回Nothing。
说明
如果未给出对象识别符，本属性返回活动工作簿中的活动工作表。
如果某一工作簿在若干个窗口中出现，那么该工作簿的ActiveSheet属性在不同窗口中可能不同。
示例
本示例显示活动工作表的名称。
MsgBox"Thenameoftheactivesheetis"&ActiveSheet.Name
39、Calculate方法
参阅应用于示例特性计算所有打开的工作簿、工作簿中的一张特定的工作表或者工作表中指定区域的单元格，如下表所示：
要计算依照本示例
所有打开的工作簿Application.Calculate（或只是Calculate）
指定工作表指定工作表
指定区域Worksheets
（1）.Rows
（2）.Calculate
expression.Calculate
expression 对于Application对象可选，对于Worksheet对象和Range对象必需。
该表达式返回“应用于”列表中的对象之一。
示例
本示例计算Sheet1已用区域中A列、B列和C列的公式。
Worksheets（"Sheet1"）.UsedRange.Columns（"A:
C"）.Calculate
程序的核心是算法问题
40、End属性
参阅应用于示例特性返回一个Range对象，该对象代表包含源区域的区域尾端的单元格。
等同于按键End+向上键、End+向下键、End+向左键或End+向右键。
Range对象，只读。
expression.End（Direction）
expression 必需。
该表达式返回“应用于”列表中的对象之一。
Direction XlDirection类型，必需。
所要移动的方向。
XlDirection可为XlDirection常量之一。
xlDown
xlToRight
xlToLeft
xlUp
示例
本示例选定包含单元格B4的区域中B列顶端的单元格。
Range（"B4"）.End（xlUp）.Select
本示例选定包含单元格B4的区域中第4行尾端的单元格。
Range（"B4"）.End（xlToRight）.Select
本示例将选定区域从单元格B4延伸至第四行最后一个包含数据的单元格。
Worksheets（"Sheet1"）.Activate
Range（"B4",Range（"B4"）.End（xlToRight））.Select
41、应用于CellFormat和Range对象的Locked属性。
本示例解除对Sheet1中A1:
G37区域单元格的锁定，以便当该工作表受保护时也可对这些单元格进行修改。
Worksheets（"Sheet1"）.Range（"A1:
G37"）.Locked=False
Worksheets（"Sheet1"）.Protect
42、Next属性
参阅应用于示例特性返回一个Chart、Range或Worksheet对象，该对象代表下一个工作表或单元格。
只读。
说明
如果指定对象为区域，则本属性的作用是仿效Tab，但本属性只是返回下一单元格，并不选定它。
在处于保护状态的工作表中，本属性返回下一个未锁定单元格。
在未保护的工作表中，本属性总是返回紧靠指定单元格右边的单元格。
示例
本示例选定sheet1中下一个未锁定单元格。
如果sheet1未保护，选定的单元格将是紧靠活动单元格右边的单元格。
Worksheets（"Sheet1"）.Activate
ActiveCell.Next.Select
43、想通过target来设置（A1：
A10）区域内有改动，就发生此事件。
不知道如何
iftarget.row=1andtarget.column<=10then
Sub列举菜单项（）
Dimr,s,iAsInteger
r=1
Fori=1ToCommandBars.Count
ActiveSheet.Cells（r,1）="CommandBars（"&i&"）.Name:
"&CommandBars（i）.Name
r=r+1
Fors=1ToCommandBars（i）.Controls.Count
ActiveSheet.Cells（r,1）=s&"、"&CommandBars（i）.Controls（s）.Caption
r=r+1
Next
Next
EndSub
44、本示例设置MicrosoftExcel每当打开包含链接的文件时，询问用户是否更新链接。
Application.AskToUpdateLinks=True
45、自定义函数
PublicFunctionNow1（）
Dimstring1AsString
string1=VBA.Date
Now1=string1
EndFunction
46、复制
Subcopy1（）
Sheet2.Range（"C5:
C10"）.CopySheet1.Range（"C5:
C10"）
EndSub
47、如何统计表中sheet的个数？
msgboxsheets.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）.s
升级会员 