zoukankan      html  css  js  c++  java
  • [VBA起步]常用的、带解释的 VBA 短句

    [VBA起步]常用的、带解释的 VBA 短句
    [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")
  • 相关阅读:
    南京邮电大学网络攻防训练平台(NCTF)-异性相吸-Writeup
    SniperOJ-as fast as you can-Writeup
    SniperOj-compare_flag-Writeup
    妙用python之编码转换
    虚拟机安装archLinux+xfce桌面教程(更新时间2017-5-8)
    2017年陕西省网络空间安全技术大赛——人民的名义-抓捕赵德汉2——Writeup
    2017年陕西省网络空间安全技术大赛——一维码——Writeup
    2017年陕西省网络空间安全技术大赛——人民的名义-抓捕赵德汉1——Writeup
    2017年陕西省网络空间安全技术大赛——种棵树吧——Writeup
    整除15问题——北理工网教
  • 原文地址:https://www.cnblogs.com/songsh96/p/650379.html
Copyright © 2011-2022 走看看