一些VBA基础代码及注释

[A65536].End(xlUp).Row 'A列末行向上第一个有值的行数
[A1].End(xlDown).Row   'A列首行向下第一个有值之行数
[A1].End(xlToLeft).Column  '第一行末列向左第一列有数值之列数。
[A1].End(xlToRight).Column  '第一行首列向右有连续值的末列之列数

Application.CommandBars("Standard").Controls(2).BeginGroup=True
'在常用工具栏的第二个按钮前插入分隔符

Cells.WrapText = False   '取消自动换行

    If Len(Target) > 5 Then
        Target.WrapText = True  '自动换行
    End If

[A1:B10].SpecialCells(xlCellTypeBlanks).Rows.Hidden = True      '有空格即隐藏行
[A2].parent.name         '返回活动单元格的工作表名
[A2].parent.parent.name  '返回活动单元格的工作簿名

range("e4").addcomment.Text "代头" & Chr(10) & "内容……"    '添加批注
range("e4").Comment.Visible = True   '显示批注

把工作簿中所有工作表的指定列调整为最佳列宽:
Sub 调整列宽()
   Dim i%                
   For i = 1 To Sheets.Count                '遍历工作簿中所有的工作表
      Sheets(i).Columns("A:K").AutoFit      '把每个工作表的[A:K]列调整为最佳列宽
   Next i                                   
End Sub

勾选"VBA项目的信任"
Application.SendKeys "%(tmstv){ENTER}"    '在 Excel 窗口操作
Application.SendKeys "%(qtmstv){ENTER}"   '在 VBE 窗口操作
Application.CommandBars("命令按钮名称").Position = msoBarFloating  '使[命令按钮]悬浮在表格中
Application.CommandBars("命令按钮名称").Position = msoBarTop       '使[命令按钮]排列在工具栏中
ActiveSheet.protect Password:="wshzw"     '为工作表保护加口令
ActiveSheet.Unprotect Password:="wshzw"   '解除工作表保护
Activesheet.ProtectContents               '判断工作表是否处于保护状态

工作表的复制与命名
ActiveSheet.Copy Before:=Sheets(1)       '复制活动工作表到第一张工作表之前
Sub wshzw()
   Dim i As Integer
   For i = 1 To 5
      Sheets("Sheet1").Copy After:=Sheets(1)  'Before/After 复制新表在 前/后
      ActiveSheet.Name = i & "月"             '为复制的新表命名
   Next i
   Sheets("Sheet1").Name = "总表"             '为 Sheets("Sheet1") 改名
End Sub

Sub 删除工作表()
    Application.DisplayAlerts = False
    Sheet1.Delete
    Application.DisplayAlerts = True
End Sub

Sub 添加工作表()
    For i = 1 To 5
        Worksheets.Add.Name = i
    Next
End Sub

Application.EnableEvents = False      
      ......
Application.EnableEvents = True   '抑制事件连锁执行

Application.EnableEvents = False
ActiveWorkbook.Save     '抑制BeforeSave事件的发生
Application.EnableEvents = True     '抑制指定事件

Application.DisplayAlerts=False  '屏蔽确认提示

Application.ScreenUpdating = False
   .......
Application.ScreenUpdating = true  '冻结屏幕以加快程序运行

ActiveCell.CurrentRegion.Select                   '选择与活动单元格相连的区域
range("a2:a20").NumberFormatLocal = "00-00"       '区域的格式化
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row     '已用区域的最末行

range("a2:a20").FormulaHidden = True    '工作表处于保护状态时隐藏部分单元格公式

FileDateTime("E:/My Documents/33.xls")
或FileDateTime(thisworkbook.FullName)     '文件被创建或最后修改后的日期和时间
FileLen(thisworkbook.FullName) / 1024
或FileLen("E:/My Documents/temp/33.xls") / 1024     '文件的长度(大小),单位是 KB

Application.AskToUpdateLinks = False    '不询问是否更新链接,并自动更新链接
ActiveSheet.Hyperlinks.Delete           '删除活动工作表超链接
ActiveWorkbook.SaveLinkValues = False   '不保存活动工作簿的外部链接值

ActiveSheet.PageSetup.CenterFooter = Range("k2").Value    '打印时设置自定义页脚
ActiveSheet.PageSetup.Orientation = xlLandscape           '设置为横向打印
ActiveSheet.PageSetup.Orientation = xlPortrait            '设置为纵向打印

Application.WindowState = xlMinimized '最小化窗口
Application.WindowState = xlNormal    '最大化窗口

[A1:A20].AdvancedFilter xlFilterCopy, [B1], Unique:=True    '可去掉重复数据
[A2:C32].Replace What:="F", Replacement:="G"                '指定范围内的查找与替换
Activesheet.AutoFilterMode = false                          '取消自动筛选

执行以下语句可有效缩小工作簿的大小,执行前请先看清每条语句的作用:
ActiveSheet.UsedRange.ClearComments             '清除活动工作表已使用范围所有批注
ActiveSheet.UsedRange.ClearFormats              '清除活动工作表已使用范围所有格式
ActiveSheet.UsedRange.Validation.Delete         '取消活动工作表已使用范围的数据有效性
ActiveSheet.Hyperlinks.Delete                   '删除活动工作表超链接
ActiveSheet.DrawingObjects.Delete               '删除活动工作表已使用范围的所有对象
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value   '取消活动工作表已使用范围的公式并保留值
还有:
Sub x()
   Dim myRange As String
   myRange = ActiveSheet.UsedRange.Address     '去除活动工作表无数据的行列
End Sub '相当于把新的已使用区域赋值给变量,效果等同于手工删除多余的列或行后立即保存

ActiveWorkbook.FullName                          '当前窗口文件名与路径
Application.AltStartupPath= "E:/My/MyStart"      '替补启动目录路径
Application.AutoRecover.Path                     '返回/设置Excel存储"自动恢复"临时文件的完整路径
Application.DefaultFilePath                      '选项>常规中的默认工作目录
Application.Evaluate("=INFO(""directory"")")     '默认工作目录
Application.LibraryPath                          '返回库文件夹的路径
Application.NetworkTemplatesPath                 '返回保存模板的网络路径
Application.Path                                 '返回应用程序完整路径
Application.RecentFiles.Item(1).Path             '返回最近使用的某个文件路径,Item(1)=第一个文件
Application.StartupPath                          'Excel启动文件夹的路径
Application.TemplatesPath                        '返回模板所存储的本地路径
Application.UserLibraryPath                      '返回用户计算机上 COM 加载宏的安装路径
Debug.Print Application.PathSeparator            '路径分隔符 "/"
CurDir                                           '默认工作目录
Excel.Parent.DefaultFilePath                     '默认工作目录
ThisWorkbook.Path                                '返回当前工作薄的路径

dim mm(2,10)
Range("a1:b10")=mm              '可以将二维数组赋值给Range

Application.Dialogs(XLdialogsaveas).show     显示保存对话框

如下代码可使工作簿打开后30秒(或闲置30秒)内不输入、不重新选择等,自动关闭工作簿
Private Sub Workbook_Open()               '工作簿打开事件
   tt                                     '工作簿打开时启动 tt 过程
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)  '工作表变化事件
   tt                                                                '工作表中任一单元格有变化时启动 tt 过程
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) '工作表选择变化事件
   tt                                                            '工作表中单元格的选择有变化时启动 tt 过程
End Sub
Sub tt()                                       'tt 过程
   Dim myNow As Date, BL As Integer            '定义myNow为日期型;定义BL为长整型
   myNow = Now                                 '把当前的时间赋给变量myNow
   Do                                          '开始循环语句Do
      BL = Second(Now) - Second(myNow)         '循环中不断检查变量BL的值
      If BL = 30 Then GoTo Cl                  '当BL=30即跳转到CL
      DoEvents                                 '转让控制权,以便sheets可继续操作
   Loop Until BL > 30                          '当BL>30即跳出循环
   Exit Sub
Cl:
   Application.EnableEvents = False            '避免引起其他事件
   ActiveWorkbook.Close True                   '关闭活动工作簿并保存
   Application.EnableEvents = True             '可触发其他事件
End Sub
  
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值