vba编程代码大全简单vba编程实例(vb编程)

VBA，神一般的办公利器，在Excel可以随意操控全公司的打印机、Word、Powerpoint等等，自动完成各种任务以及数据更新和抓取，甚至可以实现报表或者报告的更新、汇总、发送一条龙，简直是居家旅游必备神器！

此合集工具旨在提供常用代码块，让日常使用像调用函数一般容易，前人做过了无数的工作，我们只需要理解代码内容可以修改套用在自己的工作中即可，毕竟，效率第一嘛~

Sub ml()\n Dim sht As Worksheet, i&, strShtName$\n Columns(1).ClearContents\n '清空A列数据\n Cells(1, 1) = "目录"\n '第一个单元格写入字符串"目录"\n i = 1\n '将i的初值设置为1.\n For Each sht In Worksheets\n '循环当前工作簿的每个工作表\n strShtName = sht.Name\n If strShtName < ActiveSheet.Name Then\n '如果sht的名称不是当前工作表的名称则开始在当前工作表建立超链接\n i = i + 1\n '累加i\n ActiveSheet.Hyperlinks.Add anchor:=Cells(i, 1), Address:="", SubAddress:="'" & strShtName & "'!a1", TextToDisplay:=strShtName\n '建超链接\n End If\n Next\nEnd Sub

2. 一键批量取消工作表隐藏

Sub qxyc()\n Dim sht As Worksheet\n '定义变量\n For Each sht In Worksheets\n '循环工作簿里的每一个工作表\n sht.Visible = xlSheetVisible\n '将工作表的状态设置为非隐藏\n Next\nEnd Sub

3. 一键汇总各分表数据到总表

'VBA根据A列数据批量建立工作表的代码如下：\n\n\n\nSub NewSht()\n 'ExcelHome VBA编程实践与学习\n Dim Sht As Worksheet, Rng As Range\n Dim Sn, t$\n Set Rng = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)\n '将工作表名称所在的单元格区域赋值给变量Rng，单元格A1是标题，不读入\n On Error Resume Next\n '当代码出错时继续运行\n For Each Sn In Rng\n '遍历Rng(工作表名称集合）\n t = Sn\n '还记得这里我们为什么用这句代码吗？\n Set Sht = Sheets(t)\n '当工作簿不存在工作表Sheets(t)时，这句代码会出错，然后……\n If Err Then\n '如果代码出错，说明不存在工作表Sheets(t)，则新建工作表\n Worksheets.Add , Sheets(Sheets.Count)\n '新建一个工作表，位置放在所有已存在工作表的后面\n ActiveSheet.Name = t\n '新建的工作表必然是活动工作表，为之命名\n Err.Clear\n '清除错误状态\n End If\n Next\n Rng.Parent.Activate\n '重新激活名称数据所在的工作表\nEnd Sub

5. 一键将总表数据拆分为多个分表

Sub Newbooks()\n\n 'EH技术论坛。VBA编程学习与实践。看见星光\n\n Dim sht As Worksheet, mypath$\n\n With Application.FileDialog(msoFileDialogFolderPicker)\n\n '选择保存工作薄的文件路径\n\n .AllowMultiSelect = False\n\n '不允许多选\n\n If .Show Then\n\n mypath = .SelectedItems(1)\n\n '读取选择的文件路径\n\n Else\n\n Exit Sub\n\n '如果没有选择保存路径，则退出程序\n\n End If\n\n End With\n\n If Right(mypath, 1) < "\\" Then mypath = mypath & "\\"\n\n Application.DisplayAlerts = False\n\n '取消显示系统警告和消息，避免重名工作簿无法保存。当有重名工作簿时，会直接覆盖保存。\n\n Application.ScreenUpdating = False\n\n '取消屏幕刷新\n\n For Each sht In Worksheets\n\n '遍历工作表\n\n sht.Copy\n\n '复制工作表，工作表单纯复制后，会成为活动工作薄\n\n With ActiveWorkbook\n\n .SaveAs mypath & sht.Name, xlWorkbookDefault\n\n '保存活动工作薄到指定路径下，以默认文件格式\n\n .Close True '关闭工作薄并保存\n\n End With\n\n Next\n\n MsgBox "处理完成。", , "提醒"\n\n Application.ScreenUpdating = True '恢复屏幕刷新\n\n Application.DisplayAlerts = True '恢复显示系统警告和消息\n\nEnd Sub

7. 按指定条件汇总各分表数据到总表