ExcelVBA集锦

自学收集1、Application.CommandBars(WorksheetMenuBar).Enabled=false2、cells(activecell.row,b).value'活动单元格所在行B列单元格中的值3、SubCheckSheet()'如果当前工作薄中没有名为kk的工作表的话，就增加一张名为kk的工作表，并将其排在工作表从左至右顺序排列的最左边的位置，即排在第一的位置DimshtSheetAsWorksheetForEachshtSheetInSheetsIfshtSheet.Name=KKThenExitSubNextshtSheetSetshtSheet=Sheets.Add(Before:=Sheets(1))shtSheet.Name=KKEndSub4、Sheet1.ListBox1.List=Array(一月,二月,三月,四月)'一次性增加项目5、Sheet2.Rows(1).Value=Sheet1.Rows(1).Value'将一个表中的一行全部拷贝到另一个表中6、Subpro_cell()'将此代码放入sheet1,则me=sheet1,主要是认识meMe.UnprotectCells.Locked=FalseRange(D11:E11).Locked=TrueMe.ProtectEndSub7、Application.CommandBars(Ply).Enabled=False'工作表标签上快捷菜单失效8、Subaa()'把B1到B12单元格的数据填入c1到c12Fori=1To12Range(C&i)=Range(B&i)NextiEndSub9、ActiveCell.AddCommentSelection.Font.Size=12'在点选的单元格插入批注，字体为12号10、PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)Cancel=TrueEndSub11、ScrollArea属性参阅应用于示例特性以A1样式的区域引用形式返回或设置允许滚动的区域。用户不能选定滚动区域之外的单元格。String类型，可读写。说明可将本属性设置为空字符串()以允许对整张工作表内所有单元格的选定。示例本示例设置第一张工作表的滚动区域。Worksheets(1).ScrollArea=a1:f1012\ifapplication.max([a1:e1])=10thenmsgboxcommandbutton1.enabled=false'A1—E1最大的数值达到10时，自动弹出对话框，并冻结按钮12、本示例将更改的单元格的颜色设为蓝色。PrivateSubWorksheet_Change(ByValTargetasRange)Target.Font.ColorIndex=5EndSub13、Subtest()'求和DimrngAsRange,rng2AsRangeForEachrngInActiveSheet.UsedRange.ColumnsSetrng2=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)NextrngEndSub14、将工作薄中的全部n张工作表都在sheet1中建上链接Subtest2()DimPtAsRangeDimiAsIntegerWithSheet1SetPt=.Range(a1)Fori=2ToThisWorkbook.Worksheets.Count.Hyperlinks.AddAnchor:=Pt,Address:=,SubAddress:=Worksheets(i).Name&!A1SetPt=Pt.Offset(1,0)NextiEndWithEndSub15、保存所有打开的工作簿，然后退出MicrosoftExcel。ForEachwInApplication.Workbooksw.SaveNextwApplication.Quit16、让form标题栏上的关闭按钮失效PrivateSubUserForm_QueryClose(CancelAsInteger,CloseModeAsInteger)IfCloseMode1ThenCancel=TrueEndSub17、Subcountsh()'获得工作表的总数MsgBoxSheets.CountEndSub18、SubIE()'打开个人网页ActiveWorkbook.FollowHyperlinkabout:blankSendKeys{F4}ykk1976.anyp.cn{ENTER},TrueEndSub19、Subdelback()'一次性删除工作簿中所有工作表的背景ForEachshtSheetInSheetsshtSheet.SetBackgroundPictureFilename:=NextshtSheetEndSub20、[a1].formula==b1+c1'A1中设定公式为=B1+C121、PrivateSubCommandButton1_Click()'将A1到C6中大于=3的数依次放入E列DimiAsLongr=1ForEachiInRange(a1:c6)Ifi=3ThenCells(r,5)=i:r=r+1NextEndSub22、PrivateSubWorkbook_SheetChange(ByValShAsObject,ByValTargetAsRange)'显示带数字的表名b=Split(Sh.Name,()OnErrorGoTossnum=CInt(Left(b(1),Len(b(1))-1))Ifnum=1Andnum20ThenMsgBoxSh.NameEndIfExitSubss:MsgBoxerror,16,EndSub23、SubTest()'选择所有工作表名以业报开头的工作表或头两个字是业报的报表名引用SetSh=ActiveSheetIfLeft(Sh.Name,2)=业报Then'或ifsh.namelike业报*thenMsgBox你成功了,64,EndIfEndSub24、1.建立文件夹的方法MkDirD:\Music2.打开文件夹的方法ActiveWorkbook.FollowHyperlinkAddress:=D:\Music,NewWindow:=True25、在当前工作表翻页Application.SendKeys{PGUP},TrueApplication.SendKeys{PGDN},True或者ActiveWindow.LargeScrollDown:=1ActiveWindow.LargeScrollDown:=-126、当Target=*小计时如何写,*代表任何字符。ifinstr(target.value,小计)0thenPrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfTarget.ValueLike*小计ThenMsgBoxOKEndSub27、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列DimiAsLongDimiRngAsRangeForEachiRngInSheets(1).Range(a1:c6)IfiRng.Value=3Theni=i+1Sheets(1).Range(E&i).Value=iRng.ValueEndIfNextEndSub29、工作表中的窗体按钮禁用后，按钮形状不变，字体不变，从外表上无法看出其已禁用，如何设置属性使其像控件按纽那样明显的禁用？WithActiveSheet.Buttons(1).Enabled=FalseActiveSheet.Shapes(.Caption).DrawingObject.Font.ColorIndex=15EndWith復原的方法WithActiveSheet.Buttons(1).Enabled=TrueActiveSheet.Shapes(.Caption).DrawingObject.Font.ColorIndex=xlAutomaticEndWith30、PrivateSubWorksheet_SelectionChange(ByValTargetAsRange'选定A1时要输入密码IfTarget.Address=$A$1ThenA=InputBox(请输入密码,officefans)IfA=1Then[A1].SelectElse[A2].SelectEndIfEndSub31、如何将工作薄中的命名单元格成批删除！DimItemAsNameForEachItemInActiveWorkbook.NamesItem.DeleteNextItem32、平时只能看到表1，如要看表2和表3，只能通过表1的链接打开,且表2和表3回到表1后，又不可见。PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfTarget.Address=$A$3Then'当点击$A$3单元格时...Sheet2.Visible=1'取消隐藏Sheet2.Activate'激活ActiveSheet.Range(A1).SelectEndIfIfTarget.Address=$A$6ThenSheet3.Visible=1'取消隐藏Sheet3.ActivateActiveSheet.Range(A1).SelectEndIfEndSub33、将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)EndSubPrivateSubWorksheet_SelectionChange(ByValTargetAsRange)Selection.Value=ComboBox1.ValueEndSubPrivateSubWorksheet_SelectionChange(ByValTargetAsRange)'target.row代表行号'target.column代表列号i=target.row'获取行号j=target.column'获取列号EndSub35、当激活工作表时，本示例对A1:A10区域进行排序。PrivateSubWorksheet_Activate()Range(a1:a10).SortKey1:=Range(a1),Order:=xlAscendingEndSub36、BeforePrint事件参阅应用于示例特性