(代码)常用的VBA短句(带注释)

[A65536].End(xlUp).Row                            'A列末行向上第一个有值的行数

[列首行向下第一个有值之行数

[IV1].End(xlToLeft).Column                        '第一行末列向左第一列有数值之列数。

[第一行首列向右有连续值的末列之列数

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

C取消自动换行

 如果当前单元格中的字符数超过5个,执行下一行

        Target.WrapText = True        '自动换行

[有空格即隐藏行

[返回活动单元格的工作表名

[返回活动单元格的工作簿名

勾选 "VBA项目的信任"

A在 Excel 窗口操作

A在 VBE 窗口操作

Application.CommandBars("命令按钮名称").Position = msoBarFloating  '使[命令按钮]悬浮在表格中

Application.CommandBars("命令按钮名称"使[命令按钮]排列在工具栏中

A为工作表保护加口令

A解除工作表保护

A判断工作表是否处于保护状态

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

A选择与活动单元格相连的区域

R区域的格式化

A已用区域的最末行

A复制活动工作表到第一张工作表之前

R工作表处于保护状态时隐藏部分单元格公式

A不询问是否更新链接,并自动更新链接

A删除活动工作表超链接

A不保存活动工作簿的外部链接值

A打印时设置自定义页脚

A设置为横向打印

A设置为纵向打印

A最小化窗口

A最大化窗口

A当前窗口文件名与路径

A替补启动目录路径

A返回/设置Excel存储"自动恢复"临时文件的完整路径

A选项>常规中的默认工作目录

A默认工作目录

A返回库文件夹的路径

A返回保存模板的网络路径

A返回应用程序完整路径

A返回最近使用的某个文件路径,Item(1)=第一个文件

A启动文件夹的路径

A返回模板所存储的本地路径

A返回用户计算机上 COM 加载宏的安装路径

D路径分隔符 "\\"

C默认工作目录

E默认工作目录

T返回当前工作薄的路径

A定义名称

A被当前单元格所引用的区域地址

A选定当前单元格并向右延伸二格

ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count -1  '显示自动筛选后的行数

Workbooks.Close  '关闭所有工作簿

Application.Quit '关闭所有工作簿

Application.ScreenUpdating = False

  ' ......

A冻结屏幕以加快程序运行

Application.EnableEvents = False

A抑制事件连锁执行

Application.EnableEvents = False

A抑制BeforeSave事件的发生

A抑制指定事件

FileDateTime ("E:\\My Documents\\33.xls")

或

F文件被创建或最后修改后的日期和时间

FileLen (ThisWorkbook.FullName) / 1024

或

F文件的长度(大小),单位是 KB

Dim mm(2, 10)

R可以将二维数组赋值给Range

Application.Dialogs(xlDialogSaveAs).Show '显示保存对话框

T选择文件打开路径

'如下代码可使工作簿打开后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

S过程

   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可继续操作

 当BL>30即跳出循环

Cl:

   Application.EnableEvents = False            '避免引起其他事件

   ActiveWorkbook.Close True                   '关闭活动工作簿并保存

   Application.EnableEvents = True             '可触发其他事件

End Sub

Range("e4").AddComment.Text "代头" & Chr(10) & "内容……"添加批注

R显示批注

把工作簿中所有工作表的指定列调整为最佳列宽:

Sub 调整列宽()

   For i = 1 To Sheets.Count                '遍历工作簿中所有的工作表

      Sheets(i).Columns("A:K").AutoFit      '把每个工作表的[A:K]列调整为最佳列宽

End Sub

Do循环语句的几种形式:

'1.

D条件为True时执行

'... ...  '要执行的语句

Loop

'2.

D条件为False时执行

'... ...  '要执行的语句

Loop

'3.

Do

'... ...  '要执行的语句

Loop While i > 1 '条件为True时执行

'4.

Do

'... ...  '要执行的语句

Loop Until i > 1 '条件为False时执行

'5.While...Wend 语句

W条件为True时执行

'... ...  '要执行的语句

Wend

工作表的复制与命名

Sub wshzw()

 复制新表在 Sheets("Sheet1") 前/后

 月"为复制的新表命名

 总表"为 Sheets("Sheet1") 改名

End Sub

Sub 删除工作表()

End Sub

Sub 添加工作表()

End Sub

[可去掉重复数据

[指定范围内的查找与替换

A取消自动筛选

'执行以下语句可有效缩小工作簿的大小，执行前请先看清每条语句的作用:

A清除活动工作表已使用范围所有批注

A清除活动工作表已使用范围所有格式

A取消活动工作表已使用范围的数据有效性

A删除活动工作表超链接

A删除活动工作表已使用范围的所有对象

ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value      '取消活动工作表已使用范围的公式并保留值

还有:

Sub x()

   myRange = ActiveSheet.UsedRange.Address     '去除活动工作表无数据的行列

End Sub

'这相当于把新的已使用区域赋值给变量，效果等同于手工删除多余的列或行后立即保存;

来一个函数的

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'右边单元格反向显示活动单元格文本

If ActiveCell.Column < 256 Then ActiveCell.Offset(0, 1) = StrReverse(ActiveCell)

End Sub

Sub test()

Dim myRange As String

myRange = ActiveSheet.UsedRange.Address

Debug.Print "LastRow=" & Cells.SpecialCells(xlCellTypeLastCell).Row

Debug.Print "LastColumn=" & Cells.SpecialCells(xlCellTypeLastCell).Column

myRange = ""

End Sub

如上下相邻单元格数据相同则删除一个

Sub Yjue()

   Dim myCell As Range, NCell As Range        '定义

   Set myCell = ActiveSheet.Range("b2")       '把对象ActiveSheet.Range("b2")赋给变量myCell

   Do While Not IsEmpty(myCell)               '条件为True时执行

      Set NCell = myCell.Offset(1, 0)         '把对象myCell的下一个单元格赋给变量NCell

      If NCell.Value = myCell.Value Then      '如上下相邻单元格数据相同,则望下执行

          myCell.Delete                       '删除myCell

      End If                                  '结束条件语句

      Set myCell = NCell                      '把变量NCell赋给变量myCell,等于在循环中把原myCell下移了一格

End Sub

复制行高列宽与内容:

S过程的名称

   Sheet2.Rows("2:23").Copy     '复制行区域

   Sheet3.Select                '选择粘贴区域

   Range("A2").PasteSpecial Paste:=xlPasteColumnWidths   '粘贴类型

   ActiveSheet.Paste            '实施粘贴

   Application.CutCopyMode = False   '取消复制模式

End Sub

如整行为空白则删除整行:

Sub DelRow()

 把最后行的行号赋给变量

   For i = LastRow To 1 Step -1                                      '倒循环

 如整行为空白则删除整行

End Sub

'通过依次赋色给单元格的例子，展示简单的 On Error GoTo Line1 用法：

S过程名

   Dim i As Integer       '定义 i 为整型

   On Error GoTo Line1    '遇到错误跳转到 Line1

   For i = 0 To 65        '予设从 0 循环到 65

 依次赋色给第2列的单元格

      Cells(i + 1, 1) = i                      '依次给第1列的单元格标上色索引号

   Exit Sub              '退出过程

L遇到错误跳转到这行继续执行

 默认颜色只有 " & i - 1 & "种。"提示对话框

E结束过程

'通过显示或取消网格线，展示运算符“Not”应用的简单示例：

   Dim myLine As Boolean                     '定义变量myLine为布尔型

   With CommandButton1                         'With语句结构

 取消网格线"如按钮上显示为"取消网格线"

 显示网格线"改按钮上的字幕为"显示网格线"

         myLine = ActiveWindow.DisplayGridlines       '把活动窗口当前网格线的显示状态赋给变量

         ActiveWindow.DisplayGridlines = Not myLine     '进行逻辑否定运算

 取消网格线"否则按钮上显示为"取消网格线"

         ActiveWindow.DisplayGridlines = Not myLine     '进行逻辑否定运算

   End With                           '结束With语句结构

'有选择地删除指定区域内的单元格，点击按钮可选择性的删除[A1：A20]区域内含有[D1]中字样的单元格；再点击按钮可返回原样；如果替换了[D1]中的字样，点击按钮后所删除[A1：A20]区域中的单元格亦会随着变化。

 删除单元格"如按钮显示的字符为:"删除单元格

 反悔删除"则改为:"反悔删除"

         For i = 20 To 1 Step -1            '倒循环

               Cells(i, 1).Delete Shift:=xlUp     '如循环中发现某个单元格含有[D1]中字符,则删除该单元格

 删除单元格"否则让按钮显示的字符为:"删除单元格"

         Range("a1:a20") = Range("f1:f20").Value   '把[F1:F20]赋给[A1:A20],为了可反复测试

'鼠标只能在[B2:G60]以外的区域活动的例子：

   With ActiveSheet                      'With 语句,在一个单一对象上执行一系列的语句

      .Unprotect                         '解除没设密码的工作表保护

      .Cells.Locked = False              '解除活动工作表中所有单元格的“锁定”

      .Range("b2:g60").Locked = True     '只锁定 [B2:G60] 区域

      .EnableSelection = xlUnlockedCells   '仅允许选定未被有效锁定的单元格

      .Protect                           '工作表保护(没设密码)

   End With                              'With 语句结束

'一个复制数据后，只能粘贴数值的例子

Private Sub Worksheet_SelectionChange(ByVal T As Range)  '工作表SelectionChange事件

   On Error Resume Next                                  '忽略代码运行中的错误,并越过错误继续执行后面的语句

   If T.Column = 1 Then                                '如活动单元格为第一列时执行下面的语句

      Selection.PasteSpecial Paste:=xlPasteValues     '粘贴数值

      Application.CutCopyMode = False                 '立即清空剪贴板

   End If                                            'IF结构结束

E本过程结束

'如何用VBA获得工作簿名称?

For Each wbk In Workbooks

Next

1.显示活动工作簿名称

MsgBox "当前活动工作簿是" & ActiveWorkbook.Name

2.保存活动工作簿

Activeworkbook.Save

3.保存所有打开的工作簿关闭EXCEL

For Each W in Application.Workbooks

W.Save

Next W

Application.Quit

4.将网格线设置为蓝色

ActiveWindow.GridlineColorIndex = 5

5.将工作表sheet1隐藏

Sheet1.Visible = xlSheetVeryHidden

6.将工作表Shtte1显示

Sheet1.Visible = xlSheetVisible

7.单击某单元格,该单元格所在的行以蓝色背景填充,字体颜色为白色

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

If Target.Row >= 2 Then’第二行以下的区域

 5

 2

  End If

End Sub

8.使窗体在启动的时候自动最大化

Private Sub UserForm_Initialize()

End Sub

9.不保存工作簿退出EXCEL

Application.DisplayAlerts = False

Application.Quit

10.使窗体的关闭按纽不好用

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If CloseMode = vbformcontrdmenu Then

MsgBox "请用关闭按钮关闭窗口!!", , "提示"

Cancel = True

End If

End Sub

11.使窗体在3秒后自动关闭

Private Sub UserForm_Activate()

Application.Wait Now + TimeValue("00:00:03")

UserForm1.Hide

End Sub

12.启动窗体的时候自动使Label1显示Sheet1工作表3列,8行的内容

Private Sub UserForm_Activate()

Label1.Caption = Sheets("sheet1").Cells(3, 8)

End Sub

13.让按纽CommandButton1在窗体上以不可用状态显示

CommandButton1.Enabled = False

14.让按纽Commandbutton1在窗体上以隐藏方式存在

CommandButton10.Visible = False

15.点击Commandbutton1按纽进入”工资”工作表

Sheets("工资").Select

16.在Textbox1中输入数据,窗体可显示出”工资”工作表中与输入内容关联的项

Private Sub TextBox1_Change()

 For X = 1 To Application.CountA(Sheets("工资").Range("a:a"))

If Sheets("工资").Cells(X, 1) = TextBox1.Text Then’在工资表第一列查找与Textbox1输入相符的项

 工资").Cells(X, 2)’在Label2中显示Textbox1数据所在的第二列的数据

 工资").Cells(X, 3) ’在Label2中显示Textbox1数据所在的第三列的数据 End If

   Next

End Sub

17.使EXCEL启动的时候自动最小化/最大化

Private Sub Workbook_Open()

Application.WindowState = xlMinimized’最小化

Application.WindowState = xlMaximized’最大化

End Sub

18.在Label25以数字的形式显示TextBox12×Label14的结果

Label25.Caption = Val(TextBox12.Text) * Val(Label14.Caption)

19.单选按纽名与Sheet6工作表名相同

OptionButton6.Caption = Sheet6.Name

20.”登陆”窗体的显示,隐藏

登陆.Show’显示

登陆.Hide’隐藏

21.使窗体的标题栏不显示

(1)插入类模块” CFormChanger” 代码如下:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

Private Const GWL_STYLE As Long = (-16)

Private Const WS_CAPTION As Long = &HC00000

Dim hWndForm As Long

……………………………………………………………………………………………………………..

Public Property Set Form(oForm As Object) '29

If Val(Application.Version) < 9 Then

        hWndForm = FindWindow("ThunderXFrame", oForm.Caption)

    Else

        hWndForm = FindWindow("ThunderDFrame", oForm.Caption)

    End If

    SetFormStyle

End Property

……………………………………………………………………………………………………………….

Private Sub SetFormStyle()

Dim iStyle As Long, hMenu As Long, hID As Long, iItems As Integer

    iStyle = GetWindowLong(hWndForm, GWL_STYLE)

    iStyle = iStyle And Not WS_CAPTION

    iStyle = iStyle Or WS_THICKFRAME

    SetWindowLong hWndForm, GWL_STYLE, iStyle

    DrawMenuBar hWndForm

End Sub

(2)在所在窗体代码里声明

Dim oFormChanger As New CFormChanger

(3).在窗体的Activate事件中插入代码

Set oFormChanger.Form = Me

Me.SpecialEffect = fmspecia1EffectRaised

以上三步每一步都不可缺少,否则不能完成.

22.单击某单元格,该单元格所在的行与列都以蓝色背景填充

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

If Target.Row >= 2 Then’第二行以下的所有列

     On Error Resume Next

     [ChangColor_With2].FormatConditions.Delete

     [ChangColor_With3].FormatConditions.Delete

     Target.EntireRow.Name = "ChangColor_With2"

     Target.EntireColumn.Name = "ChangColor_With3"

     With [ChangColor_With2].FormatConditions

      .Delete

      .Add xlExpression, , "TRUE"

      .Item(1).Interior.ColorIndex = 5

     End With

     With [ChangColor_With3].FormatConditions

      .Delete

      .Add xlExpression, , "TRUE"

      .Item(1).Interior.ColorIndex = 5

     End With

  End If

End Sub

23.显示动态时间

（1）插入窗体Userform1及Label1并在窗体声明中插入

Option Explicit

Public nextRun As Date

（2）在窗体Activate事件中插入

Showtime

（3）在窗体QueryClose事件中插入

Application.OnTime nextRun, "showtime", schedule:=False

（4）插入模块Module1并输入

    Option Explicit

Sub showtime()

UserForm1.Label1 = Now

UserForm1.Repaint

DoEvents

UserForm1.nextRun = Now + 1 / 800

Application.OnTime UserForm1.nextRun, "showtime"

End Sub

24.加载Combobox1选项

ComboBox1.AddItem "收入型"

ComboBox1.Additem “支出型”

25.使Textbox1自动程输入状态显示(有光标闪动)

TextBox1.SetFocus

26.打开C盘目录

Shell "explorer.exe  C:\", 1