VBA自学收集.docx
《VBA自学收集.docx》由会员分享,可在线阅读,更多相关《VBA自学收集.docx(65页珍藏版)》请在冰豆网上搜索。
![VBA自学收集.docx](https://file1.bdocx.com/fileroot1/2023-2/23/4712b931-c1ee-4c2f-bbd4-36cb4dc5a8f1/4712b931-c1ee-4c2f-bbd4-36cb4dc5a8f11.gif)
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