VBA自学收集.docx

VBA自学收集.docx

《VBA自学收集.docx》由会员分享，可在线阅读，更多相关《VBA自学收集.docx（45页珍藏版）》请在冰豆网上搜索。

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

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）.select

51、PrivateSubWorkbook_Open（）

  ActiveWindow.DisplayWorkbookTabs=False'取消工作表标签

  Application.CommandBars（"Sheet"）.Controls

（1）.Enabled=False'格式＿工作表不能重命名

  Application.CommandBars.FindControl（ID:

=889）.Enabled=False'右键菜单不能重命名

EndSub

52、[a65536].End（xlUp’A列从下往上第一个非空的单元格

53、Submacro（）

Setrng=Range（"C11:

F13"）        定义RNG为一个单元格区域

ForEachcelInrng            定义CEL为RNG中