求VBA代码大全

 我来答
销香叶雨
2017-03-29 · TA获得超过3705个赞
知道大有可为答主
回答量:2045
采纳率:86%
帮助的人:466万
展开全部
1:打开所有隐藏工作表
2:循环宏
3:录制宏时调用“停止录制”工具栏
4:高级筛选5列不重复数据至指定表
5:双击单元执行宏(工作表代码)
6:双击指定区域单元执行宏(工作表代码)
7:进入单元执行宏(工作表代码)
8:进入指定区域单元执行宏(工作表代码)
9:在多个宏中依次循环执行一个(控件按钮代码)
10:在两个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)
11:在三个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)
12:根据A1单元文本隐藏/显示按钮(控件按钮代码) 
13:当前单元返回按钮名称(控件按钮代码) 
14:当前单元内容返回到按钮名称(控件按钮代码) 
15:奇偶页分别打印 
16:自动打印多工作表第一页 
17:查找A列文本循环插入分页符 
18:将A列最后数据行以上的所有B列图片大小调整为所在单元大小 
19:返回光标所在行数 20:在A1返回当前选中单元格数量 
21:返回当前工作簿中工作表数量 
22:返回光标选择区域的行数和列数 
23:工作表中包含数据的最大行数 
24:返回A列数据的最大行数 
25:将所选区域文本插入新建文本框 
26:批量插入地址批注 
27:批量插入统一批注 
28:以A1单元内容批量插入批注 
29:不连续区域插入当前文件名和表名及地址 
30:不连续区域录入当前单元地址 
31:连续区域录入当前单元地址 
32:返回当前单元地址 
33:不连续区域录入当前日期 
34:不连续区域录入当前数字日期 
35:不连续区域录入当前日期和时间 
36:不连续区域录入对勾 
37:不连续区域录入当前文件名 
38:不连续区域添加文本 
39:不连续区域插入文本 
40:从指定位置向下同时录入多单元指定内容 
41:按aa工作表A列的内容排列工作表标签顺序 
42:以A1单元文本作表名插入工作表 
43:删除所有未选定工作表 
44:工作表标签排序
45:定义指定工作表标签颜色 
46:在目录表建立本工作簿中各表链接目录 
47:建立工作表文本目录 
48:查另一文件的所有表名 
49:当前单元录入计算机名 
50:当前单元录入计算机用户名 
51:解除所有工作表保护 
52:为指定工作表加指定密码保护表 
53:在有密码的工作表执行代码 
54:执行前需要验证密码的宏(控件按钮代码) 
55:执行前需要验证密码的宏() 
56:拷贝A1公式和格式到A2 
57:复制单元数值 
58:插入数值条件格式 
59:插入透明批注 
60:添加文本 
61:光标定位到指定工作表A列最后数据行下一单元 
62:定位选定单元格式相同的所有单元格 
63:按当前单元文本定位 
64:按固定文本定位 
65:删除包含固定文本单元的行或列 
66:定位数据及区域以上的空值 
67:右侧单元自动加5(工作表代码) 
68:当前单元加2 
69:A列等于A列减B列 
70:用于光标选定多区域跳转指定单元(工作表代码) 
71:将A1单元录入的数据累加到B1单元(工作表代码) 
72:在指定颜色区域选择单元时添加/取消"√"(工作表代码) 
73:在指定区域选择单元时添加/取消"√"(工作表代码) 
74:双击指定单元,循环录入文本(工作表代码) 
75:双击指定单元,循环录入文本(工作表代码) 
76:单元区域引用(工作表代码) 
77:在指定区域选择单元时数值加1(工作表代码) 
78:混合文本的编号 
79:指定区域单元双击数据累加(工作表代码) 
80:选择单元区域触发事件(工作表代码) 
81:当修改指定单元内容时自动执行宏(工作表代码) 
82:被指定单元内容限制执行宏 
83:双击单元隐藏该行(工作表代码) 
84:高亮显示行(工作表代码) 
85:高亮显示行和列(工作表代码)
86:为指定工作表设置滚动范围(工作簿代码)
87:在指定单元记录打印和预览次数(工作簿代码)
88:自动数字金额转大写(工作表代码)
89:将所有工作表的A1单元作为单击按钮(工作簿代码)
90:闹钟——到指定时间执行宏(工作簿代码)
91:改变Excel界面标题的宏(工作簿代码)
92:在指定工作表的指定单元返回光标当前多选区地址(工作簿代码)
93:B列录入数据时在A列返回记录时间(工作表代码)
94:当指定区域修改时在其右侧的2个单元返回当前日期和时间(工作表代码)
95:指定单元显示光标位置内容(工作表代码)
96:每编辑一个单元保存文件
97:指定允许编辑区域
98:解除允许编辑区域限制
99:删除指定行
100:删除A列为指定内容的行

1:打开所有隐藏工作表

Sub 打开所有隐藏工作表()
Dim i As Integer
For i = 1 To Sheets.Count
Sheets(i).Visible = True
Next i 
End Sub
 
2:循环宏

Sub 循环()
 
 AAA = Range("C2")
  
 Dim i As Long
  Dim times As Long
  times = AAA 
'times代表循环次数,执行前把times赋值即可(不可小于1,不可大于2147483647)
  For i = 1 To times
  Call 过滤一行
 
 If Range("完成标志") = "完成" Then
    Exit For  
'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出
 
'If Sheets("传送参数").Range("A" & i).Text = "完成" Then 
Exit For 
'假如某列出现"完成"内容则退出循环
Next i 
End Sub   
     
3:录制宏时调用“停止录制”工具栏   
Sub 录制宏时调用停止录制工具栏()
      Application.CommandBars("Stop Recording").Visible = True 
End Sub        

4:高级筛选5列不重复数据至指定表
Sub 高级筛选5列不重复数据至Sheet2()
      Sheets("Sheet2").Range("A1:E65536") = "" '清除Sheet2的A:D列
     Range("A1:E65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet2.Range( _
         "A1"), Unique:=True
      Sheet2.Columns("A:E").Sort Key1:=Sheet2.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
         :=xlPinYin 
End Sub        
5:双击单元执行宏(工作表代码)   
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Range("$A$1") = "关闭" Then
Exit Sub      
Select Case Target.Address
         Case "$A$4"
             Call 宏1
             Cancel = True
         Case "$B$4"
             Call 宏2
             Cancel = True
         Case "$C$4"
             Call 宏3
             Cancel = True
        Case "$E$4"
             Call 宏4 
             Cancel = True
     End Select 
End Sub

6:双击指定区域单元执行宏(工作表代码)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     If Range("$A$1") = "关闭" Then Exit Sub
     If Not Application.Intersect(Target, Range("A4:A9", "C4:C9")) Is Nothing Then Call 打开隐藏表
 End Sub

7:进入单元执行宏(工作表代码)   
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '以单元格进入代替按钮对象调用宏      
If Range("$A$1") = "关闭" Then Exit Sub     
Select Case Target.Address
          Case "$A$5" '单元地址(Target.Address),或命名单元名字(Target.Name) 
            Call 宏1
         Case "$B$5"
             Call 宏2
         Case "$C$5"
             Call 宏3
      End Select
 End Sub

8:进入指定区域单元执行宏(工作表代码)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("$A$1") = "关闭" Then Exit Sub
If Not Application.Intersect(Target, Range("A4:A9","C4:C9")) Is Nothing Then Call 打开隐藏表 
End Sub

9:在多个宏中依次循环执行一个(控件按钮代码)

Private Sub CommandButton1_Click()
Static RunMacro As Integer
Select Case RunMacro
Case 0
宏1
RunMacro = 1
Case 1
宏2
RunMacro = 2
Case 2
宏3
RunMacro = 0
End Select 
End Sub

10:在两个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "保护工作表" Then
Call 保护工作表
 .Caption = "取消工作表保护" 
Exit Sub
End If
If .Caption = "取消工作表保护" Then
Call 取消工作表保护
 .Caption = "保护工作表" 
Exit Sub
End If
End With 
End Sub

11:在三个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)   
Option Explicit  Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "宏1" Then
Call 宏1
 .Caption = "宏2" 
Exit Sub
End If
If .Caption = "宏2" Then
Call 宏2
.Caption = "宏3"
Exit Sub
End If
If .Caption = "宏3" Then
Call 宏3
.Caption = "宏1"
Exit Sub
End If
End With 
End Sub 
12:根据A1单元文本隐藏/显示按钮(控件按钮代码)
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
If Range("A1") > 2 Then
  CommandButton1.Visible = 1
 Else
  CommandButton1.Visible = 0
 End If 
End Sub  
Private Sub CommandButton1_Click()
 重排窗口 
End Sub        

13:当前单元返回按钮名称(控件按钮代码)   
Private Sub CommandButton1_Click() 
ActiveCell = CommandButton1.Caption 
End Sub        

14:当前单元内容返回到按钮名称(控件按钮代码)   
Private Sub CommandButton1_Click() 
CommandButton1.Caption = ActiveCell 
End Sub        

15:奇偶页分别打印   
Sub 奇偶页分别打印() 
Dim i%, Ps%  
Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数 
MsgBox "现在打印奇数页,按确定开始." 
For i = 1 To Ps Step 2 
ActiveSheet.PrintOut from:=i, To:=i 
Next i  
MsgBox "现在打印偶数页,按确定开始." 
For i = 2 To Ps Step 2      
ActiveSheet.PrintOut from:=i, To:=i 
Next i 
End Sub        
16:自动打印多工作表第一页   
Sub 自动打印多工作表第一页() 
Dim sh As Integer 
Dim x 
Dim y 
Dim sy 
Dim syz  
x = InputBox("请输入起始工作表名字:") 
sy = InputBox("请输入结束工作表名字:") 
y = Sheets(x).Index 
syz = Sheets(sy).Index 
For sh = y To syz 
Sheets(sh).Select  
Sheets(sh).PrintOut from:=1, To:=1 
Next sh 
End Sub        

17:查找A列文本循环插入分页符   
Sub 循环插入分页符()  
' Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容   
Dim i As Long 
Dim times As Long  
times = Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"), "分页")      'times代表循环次数,执行前把times赋值即可(不可小于1,不可大于2147483647) 
For i = 1 To times 
Call 插入分页符 
Next i 
End Sub
Sub 插入分页符()     
Cells.Find(What:="分页", After:=ActiveCell, LookIn:=xlValues, LookAt:= _ 
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _         
.Activate      
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell 
End Sub
Sub 取消原分页()     
Cells.Select      
ActiveSheet.ResetAllPageBreaks 
End Sub

18:将A列最后数据行以上的所有B列图片大小调整为所在单元大小   
Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小()     
Dim Pic As Picture, i&      
i = [A65536].End(xlUp).Row     
For Each Pic In Sheet1.Pictures          
If Not Application.Intersect(Pic.TopLeftCell, Range("B1:B" & i)) Is Nothing Then
             Pic.Top = Pic.TopLeftCell.Top
             Pic.Left = Pic.TopLeftCell.Left
              Pic.Height = Pic.TopLeftCell.Height
             Pic.Width = Pic.TopLeftCell.Width
         End If
     Next 
End Sub

19:返回光标所在行数   
Sub 返回光标所在行数()     
x = ActiveCell.Row     
Range("A1") = x 
End Sub        

20:在A1返回当前选中单元格数量   
Sub 在A1返回当前选中单元格数量()     
[A1] = Selection.Count 
End Sub

21:返回当前工作簿中工作表数量
Sub 返回当前工作簿中工作表数量()     
t = Application.Sheets.Count     
MsgBox t 
End Sub        

 
    
93:B列录入数据时在A列返回记录时间(工作表代码)
Public Sub Worksheet_Change(ByVal Target As Range) 
If Target.Column = 2 Then 
Target.Offset(, -1) = Now 
End If 
End Sub        

94:当指定区域修改时在其右侧的2个单元返回当前日期和时间(工作表代码)   
Public Sub Worksheet_Change(ByVal Target As Range)  
If Not Application.Intersect(Target, [A1:A1000]) Is Nothing Then 
If Target.Column = 1 Then 
Target.Offset(, 1) = Date 
Target.Offset(, 2) = Time 
End If 
End If 
End Sub   

Public Sub Worksheet_Change(ByVal Target As Range)  
If Not Application.Intersect(Target, [A1:A1000]) Is Nothing Then 
If Target.Column = 1 Then  
Target.Offset(, 1) = Format(Now(), "yyyy-mm-dd") 
Target.Offset(, 2) = Format(Now(), "h:mm:ss") 
End If 
End If 
End Sub        

95:指定单元显示光标位置内容(工作表代码)   
Private Sub Worksheet_SelectionChange(ByVal T As Range) 
Sheets(1).Range("A1") = Selection 
End Sub        

96:每编辑一个单元保存文件   
Private Sub Worksheet_Change(ByVal Target As Range) 
ThisWorkbook.Save 
End Sub        

97:指定允许编辑区域
Sub 指定允许编辑区域()  
ActiveSheet.ScrollArea = "B8:G15" 
End Sub        

98:解除允许编辑区域限制   
Sub 解除允许编辑区域限制() 
ActiveSheet.ScrollArea = "" 
End Sub        

99:删除指定行   
Sub 删除指定行()  
Workbooks("临时表").Sheets("表2").Range("5:5").Delete 
End Sub        

100:删除A列为指定内容的行   
Sub 删除A列为指定内容的行() 
Dim a, b As Integer  
a = Sheet1.[a65536].End(xlUp).Row    
For b = a To 2 Step -1        
If Cells(b, 1).Value = "删除" Then          
Rows(b).Delete       
End If    
Next 
End Sub
AiPPT
2024-09-19 广告
随着AI技术的飞速发展,如今市面上涌现了许多实用易操作的AI生成工具1、简介:AiPPT: 这款AI工具智能理解用户输入的主题,提供“AI智能生成”和“导入本地大纲”的选项,生成的PPT内容丰富多样,可自由编辑和添加元素,图表类型包括柱状图... 点击进入详情页
本回答由AiPPT提供
易人dJ
2019-07-26
知道答主
回答量:1
采纳率:0%
帮助的人:720
展开全部
21-92的呢?
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 1条折叠回答
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式