分享

常用的、带解释的 VBA 短句

 gz9501 2010-10-27
常用的、带解释的 VBA 短句
2007-04-14 15:44

[A65536].End(xlUp).Row               'A列末行向上第一个有值的行数
[A1].End(xlDown).Row                 'A列首行向下第一个有值之行数
[IV1].End(xlToLeft).Column           '第一行末列向左第一列有数值之列数。
[A1].End(xlToRight).Column           '第一行首列向右有连续值的末列之列数
Application.CommandBars("Standard").Controls(2).BeginGroup=True
                                     '在常用工具栏的第二个按钮前插入分隔符
Cells.WrapText = False               '取消自动换行
     If Len(Target) > 5 Then       
                               '如果当前单元格中的字符数超过5个,执行下一行
         Target.WrapText = True       '自动换行
     End If
[A1:B10].SpecialCells(xlCellTypeBlanks).Rows.Hidden = True'有空格即隐藏行
[A2].parent.name                     '返回活动单元格的工作表名
[A2].parent.parent.name              '返回活动单元格的工作簿名

如下代码可使工作簿打开后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
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
Do循环语句的几种形式:
1.
Do While i>1      '条件为True时执行
... ...          '要执行的语句
Loop
2.
Do Until i>1      '条件为False时执行
... ...           '要执行的语句
Loop
3.
Do
... ...           '要执行的语句
Loop While i>1    '条件为True时执行
4.
Do
... ...            '要执行的语句
Loop Until i>1    '条件为False时执行
5.While...Wend 语句
While i>1         '条件为True时执行
... ...           '要执行的语句
Wend
勾选"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    
                                              '判断工作表是否处于保护状态
工作表的复制与命名
Sub wshzw()
    Dim i As Integer
    For i = 1 To 5
       Sheets("Sheet1").Copy After:=Sheets(1)   'Before/After 复制新表在 Sheets("Sheet1") 前/后
       ActiveSheet.Name = i & "月"              '为复制的新表命名
    Next i
    Sheets("Sheet1").Name = "总表"              '为 Sheets("Sheet1") 改名
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   '已用区域的最末行
ActiveSheet.Copy Before:=Sheets(1)     '复制活动工作表到第一张工作表之前
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     '最大化窗口
Sub 删除工作表()
     Application.DisplayAlerts = False
     Sheet1.Delete
     Application.DisplayAlerts = True
End Sub
有删除就有添加
Sub 添加工作表()
     For i = 1 To 5
         Worksheets.Add.Name = i
     Next
End Sub
[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      显示保存对话框
[SIZE=1]Sub x()
    Dim myRange As String
    myRange = ActiveSheet.UsedRange.Address      '去除活动工作表无数据的行列
End Sub
这相当于把新的已使用区域赋值给变量,效果等同于手工删除多余的列或行后立即保存;
来一个函数的
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'右边单元格反向显示活动单元格文本
If ActiveCell.Column 100", Operator:=xlAnd, _
         Criteria2:="<200"
     Windows(Mybo).Worksheets(She).Range("A1:K5000").Copy _
         Destination:=Windows(mybook).Worksheets("acfmis").Range("A1")

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多