VBA全屏查询模板
Excel VBA编程 典型实例——查找并替换命令
Excel VBA编程典型实例——查找并替换命令
在【代码】编辑窗口中，如果代码较多时，用户查找所需的代码就比较繁琐，因此，在VBE窗口中，提供了方便的查找代码功能，即通过【查找】对话框来实现这一功能，如同在Windows操作系统中搜索文件一样，只需输入要查找的关键字，单击【查找】按钮即可查找出相关内容。
同样，如果需要批量修改其中的VBA代码时，可以在【替换】对话框中进行替换代码操作。
1．练习要点
●打开【查找】对话框
●打开【替换】对话框
2．操作步骤：
（1）启动Excel 2007，打开“”Excel文件。
在VBE窗口中的【工程资源管理器】，右击需要查看的模块，执行【查看代码】命令，打开【代码】编辑窗口，如图2-42所示。
执行代码
图2-42 VBE窗口
（2）选择需要查找的代码，例如，查找“Trim”关键字，执行【编辑】|【查找】命令，弹出【查找】对话框，如图2-43所示。
执行
设置
输入
图2-43 弹出【查找】对话框
（3）在该对话框中，可以选择搜索范围，例如，选择【当前模块】选项按钮，然后单击【查找下一个】按钮，即对当前模块进行搜索“Trim”，并且光标停留在该关键字处，如图2-44所示。
单击
图2-44 查找下一个关键字
（4）如果需要替换该关键字，单击【替换】按钮，弹出【替换】对话框，在该对话框的【替换为】文本框中，输入需要替换的按钮，如图2-45所示。
图2-45 【替换】对话框
（5）单击对话框中的【替换】按钮，将查找的内容替换为输入的内容。
如果需要全部替换，可以单击【全部替换】按钮，将当前模块下的所有内容替换为输入的内容。
vba查询语句
vba查询语句在 VBA（Visual Basic for Applications）中，可以使用 ADO（ActiveX Data Objects）对象来执行查询语句。
以下是一个示例，展示如何在 VBA 中使用 ADO 查询语句：```vb' 建立与数据库的连接Dim cn As New ADODB.ConnectionDim rs As New ADODB.Recordset' 连接字符串Const connString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Path\To\Your\Database.accdb;"' 打开连接cn.Open(connString)' 构建查询语句Dim sql As Stringsql = "SELECT * FROM YourTable WHERE YourColumn = 'Value'"' 执行查询rs.Open(sql, cn)' 遍历结果If Not rs.EOF ThenDo While Not rs.EOF' 处理每行数据Debug.Print rs.Fields(0).Value & " " & rs.Fields(1).Valuers.MoveNextLoopEnd If' 关闭连接rs.Closecn.CloseSet rs = NothingSet cn = Nothing```请注意，上述示例中的连接字符串、查询语句和表名需要根据你的实际情况进行修改。
这个示例展示了基本的查询操作，你可以根据需要进行扩展，例如添加参数、使用聚合函数等。
同时，还可以根据实际情况设置连接的参数，如用户名、密码等。
如果你需要更详细或具体的 VBA 查询语句帮助，请提供更多的上下文和需求信息，以便我能够更好地为你提供帮助。
Excel高亮显示当前行 VBA代码
Excel高亮显示当前行VBA代码以下内容为方便EXCEL使用而开发的一个辅助代码，使用VBA 语言编写，非常有助于在使用EXCEL查阅数据时缓解视觉疲劳，减轻眼睛劳动量。
1、问题与现行解决方案说明对于一个行数和列数都比较多的Excel表格，当需要查看表格中某单元格所在行或列所对应的数据时，有时会出现看错行、看错列的情况。
虽然可以采用冻结窗格、选择行标等方法来查看，但不够方便和快捷。
当前在网上能查找到的方法主要有以下两种解决方案：1、使用VBA全选选择当前行，这样当前行就可以高亮显示。
a)、该方法的缺点是影响操作，比如你无法对某一个单元格进行设置填充色，而只能将一整行进行填充。
再比如你无法选择一片区域，页只能被VBA强制选择一整行。
此类代码绑架了EXCEL用户。
2、使用VBA改变当前行所有单元格的填充色。
a)、该方法的缺点是会清楚你当前单元格中填充色的设置，比如你的某一个表格里原本填充的是红色，而你选择过该行的某个单元格后，该行被全部重置为VBA设定的颜色，而当用户再选择其它行的单元格时，你对该单元格的填充色会被全部清楚而显示为全白底色。
这样的VBA代码强行改变了用户原来表格的设置。
另外，以上两种解决方案还有一个共同的缺点，就是每一次打开一个新的.xls文件，都要重新手动将VBA代码复制到新的EXCEL文件中，这样VBA代码才能在新的WORKBOOK中起作用，如此则代码使用起来非常不方便。
从以上分析可见，在现行的解决方案中，不论是使用便捷性，还是对用户操作的限制/束缚性，都大不尽人如意。
2、本解决方案说明本解决方案可以解决上述方案中的所有的缺点，并将对用户实际操作的影响降到最低：不绑架用户操作行为，不改变用户任何设置与表格内容。
不需要用户每次复制VBA代码，用户设置一次，后序打开任何EXCEL表格，代码均起作用。
3、personal.xlsb文件说明personal.xlsb(个人宏工作簿)文件为一个可以随EXCEL程序打开而自动加载的EXCEL工作簿，它可以隐藏不显示，并且可以保存VBA 代码（注：.xlsx文件是不能保存VBA代码的），这样我们就可以在这个工作簿中保存我们需要的VBA代码了。
vba批量查找替换文档内容的方法
vba批量查找替换文档内容的方法VBA批量查找替换文档内容的方法1. 引言在处理大量文档的时候，有时候我们需要对文档中的某个特定内容进行批量查找和替换。
VBA（Visual Basic for Applications）是一种强大的编程语言，可以用于自动化处理Office文档。
本文将介绍一些使用VBA进行批量查找替换文档内容的方法。
2. 使用Find和Replace方法VBA中的Range对象具有Find和Replace方法，可以用于查找和替换文档内容。
使用Find方法查找内容通过以下代码可以使用Find方法查找文档中的某个特定内容：Sub FindContent()Dim rng As RangeSet rng =With.Text = "要查找的内容".Forward = True.Wrap = wdFindStop.ExecuteEnd WithEnd Sub在代码中，我们首先将要查找的范围设置为整个文档的内容。
接着使用Find方法查找文档中的”要查找的内容”。
使用Replace方法替换内容通过以下代码可以使用Replace方法替换文档中的某个特定内容：Sub ReplaceContent()Dim rng As RangeSet rng =With.Text = "要查找的内容". = "要替换的内容".Forward = True.Wrap = wdFindContinue.Execute Replace:=wdReplaceAllEnd WithEnd Sub在代码中，我们首先将要替换的范围设置为整个文档的内容。
接着使用Replace方法替换文档中的”要查找的内容”为”要替换的内容”。
3. 使用正则表达式查找和替换VBA中的RegExp对象可以使用正则表达式进行更加灵活的查找和替换。
引入正则表达式库在使用正则表达式之前，需要引入正则表达式库。
Excel VBA代码 亲测可用
1、打开显示登录窗体代码打开隐藏表格，显示登录窗体private Sub Workbook_open()Application.Visible = falseUserForm1.Showend Sub2、固定账号、密码登录窗体设置（1）制作窗体（2）登录验证Private Sub CommandButton1_Click() If TextBox1 = "admin" ThenIf TextBox2 <> 123 ThenMsgBox "密码错误"Exit SubElseMsgBox "登录成功”"Unload MeApplication.Visible = TrueSheet1.ActivateEnd IfElseMsgBox "账号不存在"End IfEnd Sub（3）退出按钮Private Sub CommandButton2_Click() Unload MeThisWorkbook.CloseEnd Sub(4)打开注册窗体Private Sub CommandButton3_Click() UserForm2.ShowEnd Sub（5）唯一关闭代码Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode <> 1 Then Cancel = TrueEnd Sub3、注册账号（1）制作注册账号窗体（2）注册代码Private Sub CommandButton1_Click()Dim zh As Range, zt As RangeIf TextBox1 = "" Then MsgBox "未填入账户": Exit SubIf TextBox2 <> TextBox3 Then MsgBox "密码不一致": Exit SubSet zh = Sheets("注册").Range("a:a").Find(TextBox1.Text, , , 1)If zh Is Nothing ThenSet zt = Sheets("注册").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) zt = TextBox1.Textzt.Offset(0, 1) = TextBox2.Textzt.Offset(0, 2) = NowMsgBox "注册成功"Unload MeElseMsgBox "账号已经存在，请更换其他账号"End IfEnd Sub4、查找筛选代码Private Sub TextBox1_Change()If Len(TextBox1.Value) = 0 ThenSheet1.AutoFilterMode = FalseElseIf Sheet1.AutoFilterMode = True ThenSheet1.AutoFilterMode = FalseEnd IfSheet1.Range("B7:P" & Rows.Count).AutoFilter _field:=4, Criteria1:="*" & TextBox1.Value & "*"End IfEnd Sub5、多账号密码验证代码Private Sub CommandButton1_Click()If Len(TextBox1) = 0 Then MsgBox "未输入账号": Exit SubDim zh As RangeSet zh = Sheets("注册").Range("a:a").Find(TextBox1.Text, , , 1) If Not zh Is Nothing ThenIf TextBox2.Text <> zh.Offset(0, 1) ThenMsgBox "密码错误"Exit SubElseMsgBox "登录成功"Unload MeApplication.Visible = TrueSheet1.ActivateEnd IfElseMsgBox "账号不存在"End IfEnd Sub6、默认打开第一个工作表Private Sub Workbook_Open()Sheet1.ActivateEnd Sub7、退出保存工作表Private Sub Workbook_BeforeClose(Cancel As Boolean) ThisWorkbook.SaveEnd Sub。
VBA-数据库查询实例
VBA-数据库查询实例1.首先我们得做一个窗体，其布局和运行效果如下2.我们要理清思路，首先窗体在运行时就应该将部门加载进去，并且将重复的部门剔除掉1.Private Sub UserForm_Initialize()2.Set con = New ADODB.Connection3.With con4..Provider = "microsoft.ace.oledb.12.0"5..ConnectionString = "data source=" & ThisWorkbook.Path & "\学生管理.accdb"6..Open7.End With8.'提取9.Dim sql As String10.sql = "select distinct 部门 from 员工"11.Set rs = New ADODB.Recordset12.rs.Open sql, con, adOpenKeyset, adLockOptimistic '产生记录集13.Dim i As Integer14.'将记录集中的部门名称显示到listbox1 列表框中15.With ListBox116..Clear17.For i = 1 To rs.RecordCount18..AddItem rs("部门")19.rs.MoveNext '将记录集中的指针指向下一条记录20.Next i21.End With22.rs.Close23.End Sub3.我们要实现的是在选择部门中选择部门后，将这个部门的员工编号，姓名显示在选择员工的列表框中1.'单击列表框，查询员工信息2.Private Sub ListBox1_Click()3.Dim sql As String4.sql = "select 编号,姓名from 员工where 部门='" & ListBox1.Value & " 'order by 编号"5.rs.Open sql, con, adOpenKeyset, adLockOptimistic '产生记录集6.Dim i As Integer7.With ListBox28..Clear9.For i = 1 To rs.RecordCount10..AddItem rs("编号") & Space(2) & rs("姓名")11.rs.MoveNext '将记录集中的指针指向下一条记录12.Next i13.End With14.rs.Close15.End Sub4.将选择员工后，把员工的对应信息显示在对应的文本框中，便可以实现查询功能1.'单击列表框，将对应的信息显示在对应的文本框中2.Private Sub ListBox2_Click()3.Dim sql As String4.sql = "select * from 员工where 编号='" & Left(ListBox2.Value, 6) & "'"5.rs.Open sql, con, adOpenKeyset, adLockOptimistic6.Dim arr, i As Integer7.arr = Array("T extBox1", "TextBox2", "TextBox3", "TextBox4", "TextBox5", "TextBox6", "T extBox7", "TextBox8", "T extBox9","TextBox10")8.For i = 0 To 79.Me.Controls(arr(i)).Value = rs.Fields(i)10.Next i11.rs.Close12.End Sub5.完整代码及解释如下1.Option Explicit2.Dim con As ADODB.Connection3.Dim rs As ADODB.Recordset4.'关闭数据库连接，关闭窗体，释放变量空间5.Private Sub CommandButton1_Click()6.con.Close7.Set rs = Nothing8.Set con = Nothing9.Unload Me10.End Sub11.'单击列表框，查询员工信息12.Private Sub ListBox1_Click()13.Dim sql As String14.sql = "select 编号,姓名 from 员工 where 部门='" & ListBox1.Value & " 'order by 编号"15.rs.Open sql, con, adOpenKeyset, adLockOptimistic '产生记录集16.Dim i As Integer17.With ListBox218..Clear19.For i = 1 To rs.RecordCount20..AddItem rs("编号") & Space(2) & rs("姓名")21.rs.MoveNext '将记录集中的指针指向下一条记录22.Next i23.End With24.rs.Close25.End Sub26.'单击列表框，将对应的信息显示在对应的文本框中27.Private Sub ListBox2_Click()28.Dim sql As String29.sql = "select * from 员工where 编号='" & Left(ListBox2.Value, 6) & "'"30.rs.Open sql, con, adOpenKeyset, adLockOptimistic31.Dim arr, i As Integer32.arr = Array("T extBox1", "T extBox2", "TextBox3", "TextBox4", "TextBox5", "T extBox6", "TextBox7", "T extBox8", "TextBox9", "TextBox10")33.For i = 0 To 734.Me.Controls(arr(i)).Value = rs.Fields(i)35.Next i36.rs.Close37.End Sub38.39.Private Sub UserForm_Initialize()40.Set con = New ADODB.Connection41.With con42..Provider = "microsoft.ace.oledb.12.0"43..ConnectionString = "data source=" & ThisWorkbook.Path & "\学生管理.accdb"44..Open45.End With46.'提取47.Dim sql As String48.sql = "select distinct 部门 from 员工"49.Set rs = New ADODB.Recordset50.rs.Open sql, con, adOpenKeyset, adLockOptimistic '产生记录集51.Dim i As Integer52.'将记录集中的部门名称显示到listbox1 列表框中53.With ListBox154..Clear55.For i = 1 To rs.RecordCount56..AddItem rs("部门")57.rs.MoveNext '将记录集中的指针指向下一条记录58.Next i59.End With60.rs.Close61.End Sub。
VBA代码全集模板
目录一、引用 (3)二、Worksheet_Change事件： (3)三、相乘 (5)四、相减 (6)五、高级筛选 (6)六、双击事件 (8)七．单位汇总（sumif），单条件汇总 (10)八、多条件汇总（连接、sumif） (13)九、多条件汇总、ado (15)十、对账 (16)十一、sql筛选 (20)十二、sql连接、交叉汇总 (21)十三、select语句总结 (23)十四、报表（有层次） (24)一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。
二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2. Worksheet_Change事件代码：Private Sub Worksheet_Change(ByVal Target As Range)On error resume nextIf Target.Row > 3 And Target.Column = 2 Theni = Target.RowCells(i, 3) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets("简码表").Range("b4:c100"), 2, False)End IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range)On Error Resume NextIf Target.Row > 3 And Target.Column = 5 Theni = Target.RowCells(i, 6) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 2, False)Cells(i, 7) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 3,False)Cells(i, 8) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 4, False)End IfEnd Sub三、相乘Sub 计算金额()Application.ScreenUpdating = FalseDim i As LongDim irow As Longirow = Range("a3").End(xldown).RowFor i = 4 To irowCells(i, 3) = Cells(i, 1) * Cells(i, 2)Next iApplication.ScreenUpdating = TrueEnd Sub四、相减Sub 相减()Application.ScreenUpdating = FalseRange("c3:c10000").ClearContentsDim i As LongDim irow As Longirow = Range("a5000").End(xlUp).RowFor i = 3 To irowCells(i, 3) = VBA.Round((Cells(i, 1) - Cells(i, 2)), 2)Next iApplication.ScreenUpdating = TrueEnd Sub五、高级筛选（工具-宏-录制新宏，宏名改成高级筛选）Sub 高级筛选()Sheets("业务").Range("A3:I10000").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=ActiveCell.Range("A1:B1"), Unique:=TrueEnd Sub六、双击事件1.插入-名称-定义（修改名称和引用位置）2．查看代码-插入-用户窗体工具箱-多页、列表框-右键属性点击page1修改caption为资产类-点击空白列表框修改rowsource 为box1依次类推3. 业务表-查看代码 Worksheet beforedoubleclickPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 3 And Target.Column = 6 ThenUserForm1.ShowSheets("初始化").Range("m3") = ActiveCellElseIf Target.Row > 3 And Target.Column = 7 ThenUserForm2.ShowEnd IfEnd Sub备查代码：Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 3 And Target.Column = 6 ThenUserForm1.ShowSheets("初始化").Range("c2") = ActiveCellElseIf Target.Row > 3 And Target.Column = 7 ThenUserForm2.ShowSheets("初始化").Range("f2") = ActiveCellElseIf Target.Row > 3 And Target.Column = 8 ThenUserForm3.ShowEnd IfEnd Sub4．右键点击Userform1查看代码 Listbox1 dbclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox2.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox3.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox4.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox5.ListIndex, 0)Unload MeEnd Sub见上图5.插入用户窗体右键点击userform2 worksheet dblclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 7) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubUserform initializePrivate Sub UserForm_Initialize()Application.ScreenUpdating = FalseWith Sheets("初始化")Sheets("科目表").Range("h2:i10000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Range("m2:m3"), CopyToRange:=.Range("n2"), Unique:=TrueEnd WithApplication.ScreenUpdating = TrueEnd Sub七．单位汇总（sumif），单条件汇总=SUMIF(业务!$D$4:$D$1000,单位汇总!$A15,业务!I$4:I$10000)Sub 单位汇总1()Application.ScreenUpdating = Falserange("a1:i10000").ClearCells(3, 2) = "指标数"Cells(3, 3) = "拨款数"Cells(3, 4) = "余额"Cells(1, 7) = "单位"Cells(3, 7) = "单位"Cells(3, 8) = "指标数"Cells(3, 9) = "拨款数"Sheets("业务").Range("D3:D10000").AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range("A3"), Unique:=TrueSheets("业务").Range("A3:J10000").AdvancedFilter Action:=xlFilterCopy, _CriteriaRange:=Range("G1:G2"), CopyToRange:=Range("G3:I3"), Unique:=FalseDim i As LongDim irow As Longirow = Range("a3").End(xlDown).RowFor i = 4 To irowCells(i, 2) = Application.WorksheetFunction.SumIf(Range("g4:g10000"), Cells(i, 1), Range("h4:h10000"))Cells(i, 3) = Application.WorksheetFunction.SumIf(Range("g4:g10000"), Cells(i, 1), Range("i4:i10000"))Cells(i, 4) = VBA.Round(Cells(i, 2) - Cells(i, 3), 2)Next iRange("g1:i10000").ClearApplication.ScreenUpdating = TrueEnd Sub八、多条件汇总（连接、sumif）连接=k4&l4&m4&n4Vba：Sub 多条件汇总()Application.ScreenUpdating = FalseRange("a1:p10000").ClearSheets("业务").Range("D3:G10000").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("B3:E3"), Unique:=TrueSheets("业务").Range("D3:I10000").AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range("K3:P3"), Unique:=FalseDim j As LongDim jrow As Longjrow = Range("k3").End(xlDown).RowFor j = 4 To jrowCells(j, 10) = Cells(j, 11) & Cells(j, 12) & Cells(j, 13) & Cells(j, 14)Next jDim i As LongDim irow As Longirow = Range("b3").End(xlDown).RowFor i = 4 To irowCells(3, 6) = "指标数"Cells(3, 7) = "拨款数"Cells(3, 8) = "余额"Cells(i, 1) = Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5)Cells(i, 6) = Application.WorksheetFunction.SumIf(Range("j4:j10000"), Cells(i, 1), Range("o4:o10000"))Cells(i, 7) = Application.WorksheetFunction.SumIf(Range("j4:j10000"), Cells(i, 1), Range("p4:p10000"))Cells(i, 8) = VBA.Round(Cells(i, 6) - Cells(i, 7), 2)Next iRange("i3:p10000").ClearRange("a1:a10000").DeleteApplication.ScreenUpdating = TrueEnd Sub九、多条件汇总、adoSub 多条件汇总()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标,sum(拨款数) as 预算股拨款 from[业务$a3:J10000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("多条件汇总").Cells(3, i) = rst.Fields(i - 1).Name Next iSheets("多条件汇总").Range("a4").CopyFromRecordset rst rst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十、对账Sub 预算股()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql1 = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标 from[预算股$a3:m50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets("对帐").Cells(3, i + 10) = rst1.Fields(i - 1).NameNext iSheets("对帐").Range("k4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql2 = " SELECT 单位,类,款,项, sum(指标数) as 专业股指标 from[专业股$a3:j50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets("对帐").Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets("对帐").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = Nothings = Application.WorksheetFunction.CountA(Range("k4:k10000")) + 4Range("T4:W10000").SelectSelection.CopyRange("K" & s).SelectActiveSheet.PasteRange("X4:X10000").SelectSelection.CopyRange("P" & s).SelectActiveSheet.PasteRange("X3").SelectSelection.CopyRange("P3").SelectActiveSheet.PasteDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项, sum(预算股指标) as 预算股指标 ,sum(专业股指标) as 专业股指标 from[对帐$k3:p50000] GROUP BY 单位,类,款,项"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("对帐").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("对帐").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十一、sql筛选Sub 筛选()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT distinct 单位,类,款,项 from[专业$a3:h10000]"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("筛选").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("筛选").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = True End Sub十二、sql连接、交叉汇总Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 股,月,归口,单位,类,款,项,指标数 from [专业$a3:h10000] union ALL SELECT 股,月,归口,单位,类,款,项,指标数 from [预算$a3:l10000] order by 股 desc"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("连接").Cells(1, i + 19) = rst.Fields(i - 1).NameNext iSheets("连接").Range("t2").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 汇总()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " transform sum(指标数) SELECT 单位,类,款,项 from [连接$t1:aa10000] where 归口= '" & Range("h2").Value & "' and 月=" & Range("i2").Value & " group by 单位,类,款,项 pivot 股" rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("连接").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("连接").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingRange("t1:aa10000").ClearContentsApplication.ScreenUpdating = TrueEnd Sub十三、select语句总结1、筛选（false ---筛选全部）Select 列表名称1,列表名称2,…….列表名称n from [表$区域]或者Select * from [表$区域]2、筛选唯一的数据Select distinct 列表名称1,列表名称2,…….列表名称n from [表$区域]3、分类汇总Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]Group by列表名称1,列表名称2,…….列表名称n4、条件分类汇总Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]Where 归口=’”& range(“”).value &”’ and 月=”& range(“”).value &” Group by列表名称1,列表名称2,…….列表名称n5、交叉汇总Transform sum() select 列名称1,……列名称n from[表$区域] group by 列名称1，…..列名称n pivot 交叉事项6、连接Select 列名称1，…列名称n from[表$区域] union all Select 列名称1，…列名称n from[表$区域] order by 列名称 desc十四、报表（有层次）连接Transform sum（指标数），pivot 股按单位、类、款进行汇总按单位、类进行汇总按单位进行汇总连接以上四个表的内容，并按单位、类、款、项进行排序，其中单位按降序排序1、整体写代码Sub 报表()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql1 = " SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group by 股,月,归口,单位,类,款,项 union all SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[预算$a3:l10000] group by 股,月,归口,单位,类,款,项 order by 股 desc"rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets("报表").Cells(3, i + 9) = rst1.Fields(i - 1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql2 = "transform sum(指标数) SELECT 单位,类,款,项 from[报表$j3:q10000] where 归口='" & Range("g2") _.Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项 order by 单位 desc pivot 股 "rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets("报表").Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = NothingDim strsql3 As StringDim cnn3 As New ADODB.ConnectionDim rst3 As New ADODB.Recordsetcnn3.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql3 = "SELECT 单位,类,款,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位,类,款 order by 单位 desc"rst3.Open strsql3, cnn3For i = 1 To rst3.Fields.CountSheets("报表").Cells(3, i + 26) = rst3.Fields(i - 1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rst3rst3.Closecnn3.CloseSet rst3 = NothingSet cnn3 = NothingDim strsql4 As StringDim cnn4 As New ADODB.ConnectionDim rst4 As New ADODB.Recordsetcnn4.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql4 = "SELECT 单位,类,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位,类 order by 单位 desc"rst4.Open strsql4, cnn4For i = 1 To rst4.Fields.CountSheets("报表").Cells(3, i + 32) = rst4.Fields(i - 1).NameNext iSheets("报表").Range("ag4").CopyFromRecordset rst4rst4.Closecnn4.CloseSet rst4 = NothingSet cnn4 = NothingDim strsql5 As StringDim cnn5 As New ADODB.ConnectionDim rst5 As New ADODB.Recordsetcnn5.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql5 = "SELECT 单位,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位 order by 单位 desc"rst5.Open strsql5, cnn5For i = 1 To rst5.Fields.CountSheets("报表").Cells(3, i + 37) = rst5.Fields(i - 1).NameNext iSheets("报表").Range("al4").CopyFromRecordset rst5rst5.Closecnn5.CloseSet rst5 = NothingSet cnn5 = NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightRange("ad3") = "项"Columns("Aj:Ak").SelectSelection.Insert Shift:=xlToRightRange("aj3") = "款"Range("ak3") = "项"Columns("Ap:Ar").SelectSelection.Insert Shift:=xlToRightRange("ap3") = "类"Range("aq3") = "款"Range("ar3") = "项"Dim strsql6 As StringDim cnn6 As New ADODB.ConnectionDim rst6 As New ADODB.Recordsetcnn6.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql6 = " SELECT 单位,类,款,项,专业股,预算股 from [报表$t3:y10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ao3:at10000] order by 单位 desc,类,款,项 "rst6.Open strsql6, cnn6For i = 1 To rst6.Fields.CountSheets("报表").Cells(3, i) = rst6.Fields(i - 1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rst6rst6.Closecnn6.CloseSet rst6 = NothingSet cnn6 = NothingRange("j1:au10000").ClearContentsDim p As LongDim prow As Longprow = Range("a3").End(xlDown).RowFor p = 4 To prowRange("g3") = "金额"Cells(p, 7) = VBA.Round(Cells(p, 6) - Cells(p, 5), 2)Next pApplication.ScreenUpdating = TrueEnd Sub2、分开写代码：Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 月,归口,股,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group by 月,归口,股,单位,类,款,项 union all SELECT 月, 归口,股,单位,类,款,项,sum(指标数) as 指标数 from[预算$a3:l10000] group by 月, 归口,股,单位,类,款,项 order by 股 desc"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 9) = rst.Fields(i - 1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 项()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';DataSource=" & ThisWorkbook.FullNamestrsql = "transform sum(指标数) SELECT 单位,类,款,项 from [报表$j3:q10000] where 归口= '" & Range("g2").Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项 pivot 股"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 19) = rst.Fields(i - 1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 款()Application.ScreenUpdating = FalseCall 项Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$t3:y10000] group by 单位,类,款 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 26) = rst.Fields(i - 1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightCells(3, 30) = "项"Application.ScreenUpdating = TrueEnd SubSub 类()Application.ScreenUpdating = FalseCall 款Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$aa3:af10000] group by 单位,类 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 33) = rst.Fields(i - 1).NameNext iSheets("报表").Range("ah4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingColumns("AJ:AJ").SelectSelection.Insert Shift:=xlToRightColumns("AK:AK").SelectSelection.Insert Shift:=xlToRightRange("AJ3").SelectActiveCell.FormulaR1C1 = "款"Range("AK3").SelectActiveCell.FormulaR1C1 = "项"Application.ScreenUpdating = TrueEnd SubSub 单位()Application.ScreenUpdating = FalseCall 类Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$ah3:am10000] group by 单位 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 40) = rst.Fields(i - 1).NameNext iSheets("报表").Range("ao4").CopyFromRecordset rstrst.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = True Columns("AP:AP").SelectSelection.Insert Shift:=xlToRight Columns("AQ:AQ").SelectSelection.Insert Shift:=xlToRight Columns("AR:AR").SelectSelection.Insert Shift:=xlToRight Range("AP3").SelectActiveCell.FormulaR1C1 = "类"Range("AQ3").SelectActiveCell.FormulaR1C1 = "款"Range("AR3").SelectActiveCell.FormulaR1C1 = "项" End SubSub 报表()If Range("i2") = "类" ThenCall 类ElseIf Range("i2") = "款" ThenCall 款ElseCall 项End IfEnd SubSub 总报表()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项,专业股,预算股 from [报表$t3:y10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ao3:at10000] order by 单位 desc,类,款,项 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingRange("j1:br10000").ClearApplication.ScreenUpdating = TrueEnd Sub插入图片Sub 按钮48_单击() 宏按钮名，编码时自动生成On Error Resume NextDim MR As RangeFor Each MR In SelectionIf Not IsEmpty(MR) ThenMR.SelectML = MR.LeftMT = MR.TopMW = MR.WidthMH = MR.HeightActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).SelecterPicture _End IfNextEnd Sub与EXCEL表在同一个文件夹里，。
VBA中常见的函数与方法速查手册
VBA中常见的函数与方法速查手册VBA（Visual Basic for Applications）是一种用于编写Microsoft Office套件中宏和自定义函数的编程语言。
作为Microsoft Office产品的一部分，VBA具有强大的功能和灵活性，可以帮助用户自动化处理数据、生成报表、操作图形等。
在VBA中，函数和方法是最基础且最常用的工具。
本文将为您提供VBA中常见的函数与方法速查手册，以便您熟练运用VBA进行自动化编程。
一、常见的函数1. Msgbox函数Msgbox函数用于在窗口中显示一条消息，并返回一个按键值。
语法：Msgbox(prompt[, buttons] [, title] [, helpfile, context])示例：Msgbox "Hello, World!"，vbInformation+vbOKCancel，"提示"2. InputBox函数InputBox函数用于在窗口中显示一个对话框，提示用户输入一个值。
语法：InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])示例：Value = Inputbox("请输入一个数字：")3. Len函数Len函数用于返回字符串的长度。
语法：Len(string)示例：Len("Hello, World!") ' 返回结果为134. Left函数Left函数用于返回字符串左边指定个数的字符。
语法：Left(string, length)示例：Left("Hello, World!", 5) ' 返回结果为"Hello"5. Right函数Right函数用于返回字符串右边指定个数的字符。
语法：Right(string, length)示例：Right("Hello, World!", 6) ' 返回结果为"World!"6. Mid函数Mid函数用于返回字符串中指定位置的字符。
VBA中的快速查找与替换技巧与实例
VBA中的快速查找与替换技巧与实例在VBA中，快速查找和替换是编程过程中非常常见的任务之一。
无论是在处理文本字符串、工作表数据还是在访问数据库时，查找和替换操作都可以大幅提高代码的效率和可读性。
本文将向您介绍一些VBA中的快速查找和替换技巧，并提供相应的实例供您参考。
一、查找函数VBA中的查找函数可以用来在字符串中查找特定的文本，并返回其位置索引。
常用的查找函数有以下几种：1. InStr函数：该函数用于在一个字符串中查找另一个字符串，并返回第一次出现的位置索引。
例如，以下代码将查找字符串"example"在字符串"this is an example"中的位置，并返回结果3。
```Dim position As Integerposition = InStr(1, "this is an example", "example")```2. InStrRev函数：与InStr函数类似，但从字符串的末尾开始查找并返回最后一次出现的位置索引。
以下代码将返回字符串"this is an example"中最后一次出现字符串"example"的位置索引14。
```Dim position As Integerposition = InStrRev("this is an example", "example")```3. InStrRev函数的变体：除了查找最后一次出现的位置索引，InStrRev函数还可以指定起始位置。
以下代码将返回字符串"this is an example"中，从位置索引5开始查找最后一次出现字符串"example"的位置索引8。
```Dim position As Integerposition = InStrRev("this is an example", "example", 5)```二、替换函数在VBA中，替换函数用于将字符串中的特定文本替换为新的文本。
VBA中的数据查询和筛选技巧
VBA中的数据查询和筛选技巧在VBA编程中，数据查询和筛选技巧是非常重要的，它能够帮助开发人员有效地管理和分析大量的数据。
本文将介绍一些VBA中常用的数据查询和筛选技巧，包括使用VBA进行数据查询、排序和筛选、动态查询、高级筛选等。
一、使用VBA进行数据查询、排序和筛选1. 数据查询：VBA中的数据查询可以通过使用SQL语句实现。
首先，我们需要通过ADO对象连接到数据库，然后使用SQL语句进行数据查询。
例如，我们可以使用SELECT语句选择特定的数据表或字段，并使用WHERE子句指定查询条件。
通过将查询结果返回到记录集中，我们可以使用VBA代码对查询结果进行处理和分析。
2. 数据排序：在VBA中，数据排序可以通过使用Range对象的Sort方法实现。
我们可以选择要排序的区域，然后指定排序的列和排序的方式（升序或降序）。
通过使用VBA代码，我们可以轻松地对Excel工作表中的数据进行排序，以便更好地进行数据分析和整理。
3. 数据筛选：在VBA中，我们可以使用AutoFilter方法对Excel表格进行数据筛选。
我们可以选择要筛选的列，然后指定筛选的条件。
使用VBA代码，我们可以根据需要筛选出满足条件的数据，从而更好地进行数据分析和处理。
二、动态查询动态查询是指根据用户的输入或特定的条件，实时地查询并显示数据。
在VBA编程中，我们可以使用文本框或下拉列表框等控件，允许用户输入查询条件。
根据用户输入的条件，我们可以使用VBA代码执行相应的查询操作，并将查询结果显示在工作表中。
通过动态查询，用户可以根据自身的需求随时获取所需要的数据，提高工作效率。
三、高级筛选除了普通的筛选功能，VBA还提供了一些高级筛选技巧，用于更复杂的数据筛选和分析。
例如，我们可以使用VBA代码创建动态的筛选条件，包括多个筛选条件的组合和逻辑运算。
我们还可以使用VBA代码将筛选结果导出到新的工作表或文件中，以便进一步分析和整理。
四、实例演示下面是一个简单的示例，演示如何使用VBA进行数据查询和筛选。
完全手册ExcelVBA典型实例大全
完全手册Excel VBA典型实例大全：通过368个例子掌握目录第1章宏的应用技巧宏是一个VBA程序，通过宏可以完成枯燥的、频繁的重复性工作。
本章的实例分别介绍在Excel 2003、Excel 2007中录制宏、使用Visual Basic代码创建宏的方法，最后还以实例演示运行宏和编辑宏的方法。
1.1 创建宏 1例001 在Excel 2003中录制宏 1例002 打开Excel 2007的录制宏功能 3例003 在Excel 2007中录制宏 4例004 使用Visual Basic创建宏 51.2 管理宏 6例005 运行宏7例006 编辑宏8第2章VBE使用技巧VBE（Visual Basic Editor）是编写VBA代码的工具，在上一章中曾使用VBE编辑宏代码。
本章的实例介绍了设置VBE操作环境、在VBE中管理工程代码、使用VBE的辅助工具提高代码输入效率等方法。
2.1 设置VBE操作环境10例007 停靠VBE子窗口10例008 定制VBE环境122.2 工程管理13例009 增加模块 13例010 删除模块 15例011 导出模块 16例012 导入模块 172.3 管理代码18例013 属性/方法列表18例014 常数列表 19例015 参数信息 20例016 自动完成关键字21第3章程序控制流程技巧结构化程序设计中使用的基本控制结构有3种：顺序结构、选择结构和循环结构。
本章以实例演示了VBA中这三种控制结构的控制语句，最后还介绍了在VBA中使用数组的方法。
3.1 常用输入/输出语句23例017 九九乘法表（Print方法的应用） 23例018 输入个人信息（Inputbox函数的应用）24例019 退出确认（Msgbox函数的应用）253.2 分支结构27例020 突出显示不及格学生27例021 从身份证号码中提取性别29例022 评定成绩等级 30例023 计算个人所得税323.3 循环结构34例024 密码验证 34例025 求最小公倍数和最大公约数 36例026 输出ASCII码表37例027 计算选中区域数值之和 39例028 换零钱法（多重循环） 403.4 使用数组42例029 数据排序 42例030 彩票幸运号码 44例031 用数组填充单元格区域 46第4章Range对象操作技巧用户在使用Excel时，大部分时间都是在操作单元格中的数据，同样地，在Excel中使用VBA编程时，也需要频繁地引用单元格区域。
使用VBA检测EXCEL窗口状态
使用VBA检测EXCEL窗口状态在前面几篇文章里，我们讨论学习了VBA的一些基本用法，都是非常简单的应用，在这篇文章中我们学习VBA 稍复杂的用法，也就是多语句的应用。
使用VBA检测EXCEL窗口状态一般来说，我们会把EXCEL窗口打开到最大，也可能是EXCEL窗口一般化或最小化，在EXCEL中都可以用VBA来检测EXCEL窗口的状态。
我们先来看实现这个功能的VBA语句。
Public Sub 检测EXCEL窗口状态() Dim zhuangtai As String zhuangtai = If zhuangtai = xlMaximized Then MsgBox “当前EXCEL窗口最大化”, vbInformation ElseIf zhuangtai = xlMinimized Then MsgBox “当前EXCEL窗口最小化”, vbInformation ElseIf zhuangtai = xlNormal Then MsgBox “当前EXCEL窗口一般显示”, vbInformation End IfEnd Sub 上面这段程序就是标准的VBA程序了，我们来一一学习一下。
Public Sub 检测EXCEL 窗口状态()：这一句写在整个EXCELVBA程序的最前面，通过sub我们可以知道这是一个过程，VBA的过程就是一组完成所要求操作任务的VBA语句。
Dim zhuangtai As String是在VBA程序中声明变量，zhuangtai就是一个变量，在这里我们声明变量为String。
zhuangtai = 就是把窗口状态这个应用赋与zhuangtaip这个变量，使zhuangtai这个变量在以后的VBA程序中代替以便让VBA程序更加易读。
If zhuangtai = xlMaximized Then MsgBox “当前EXCEL窗口最大化”, vbInformation ElseIf zhuangtai = xlMinimized Then MsgBox “当前EXCEL窗口最小化”, vbInformation ElseIf zhuangtai = xlNormal Then MsgBox “当前EXCEL窗口一般显示”, vbInformation End If这是一个VBA中最常用的IF循环，在这个循环中我们嵌入了三个IF循环，vbInformation是VBA 的MsgBox显示信息图标的参数，以If zhuangtai = xlMaximized Then MsgBox “当前EXCEL窗口最大化”, vbInformation为例，语法的意思是，如果zhuangtai这个变量等于xlMaximized这个值，那么，EXCEL信息窗口显示”当前EXCEL窗口最大化”这个信息。
vba基础入门查询案例
VBA基础入门查询案例什么是VBA？VBA（Visual Basic for Applications）是一种通用性的编程语言，用于开发应用程序和自动化任务。
VBA主要用于Microsoft Office套件中的应用程序，如Excel、Word、PowerPoint等。
VBA允许用户编写宏（Macro），通过宏可以实现一系列的操作和功能。
VBA的基本结构VBA的基本结构由以下几个部分组成：Sub和Function在VBA中，Sub和Function是两种主要的代码块。
Sub是指Subroutine，用于执行一系列的操作，而Function用于返回一个结果。
变量和数据类型在VBA中，我们需要定义和使用变量来存储和操作数据。
VBA支持多种数据类型，包括整数、浮点数、字符串等。
控制结构VBA支持多种控制结构，用于控制程序的执行流程。
常用的控制结构包括条件语句（If…Then…Else）、循环语句（For…Next、Do…Loop）、选择语句（Select Case）等。
对象和方法VBA是基于对象的，可以使用对象和对象的方法来实现各种功能。
MicrosoftOffice应用程序中的各种元素（如单元格、工作表、文本框等）都是对象，可以通过调用对象的方法来进行操作。
VBA查询案例下面，我们以一个简单的VBA查询案例来说明VBA的基本用法和功能。
问题描述假设我们有一个存储学生信息的Excel表格，其中包含学生的姓名、性别、年龄等信息。
我们想要编写一个VBA程序，通过输入学生姓名，来查询该学生的信息。
VBA代码实现步骤以下是实现该查询功能的VBA代码步骤：1.定义变量：首先需要定义几个变量来存储输入的学生姓名和查询结果。
使用Dim语句进行变量定义。
2.获取输入：使用InputBox函数获取用户输入的学生姓名。
3.循环遍历：使用For…Each循环语句遍历Excel表格中的每一行，寻找匹配的学生姓名。
4.判断匹配：使用条件语句判断当前行的学生姓名是否与输入的学生姓名匹配。
使用VBA实现快速数据筛选与查询
使用VBA实现快速数据筛选与查询数据在现代商业中扮演了至关重要的角色。
对于那些处理大量数据的人来说，能够快速而有效地筛选和查询数据是一项重要的技能。
在Excel等电子表格软件中，VBA（Visual Basic for Applications）是一种强大的编程语言，可以帮助我们实现快速数据筛选与查询功能。
本文将介绍如何使用VBA编写代码来实现这些功能。
首先，我们需要了解一些基础概念。
在Excel中，数据通常存储在一个表格中，其中每个单元格都有一个唯一的地址，表示为行号和列号的组合。
用VBA编写的代码可以通过引用这些地址来访问和操作表格中的数据。
一、数据筛选数据筛选是根据特定条件从数据集合中提取所需信息的过程。
VBA中有几种方法可以实现数据筛选：1. 自动筛选自动筛选是Excel中的一种功能，也可以通过VBA代码来实现。
我们可以使用"AutoFilter"方法来筛选数据。
以下是一个简单的例子：```vbaSub AutoFilterExample()Range("A1").AutoFilter Field:=1, Criteria1:="Value"End Sub```上述代码将在A列上进行筛选，只显示满足条件的行，其中第一列的值为"Value"。
2. 使用筛选条件我们也可以使用VBA代码根据特定的条件对数据进行筛选。
以下是一个示例代码：```vbaSub FilterExample()Dim ws As WorksheetDim rng As RangeSet ws = ThisWorkbook.Sheets("Sheet1") ' 设置工作表' 设置筛选范围Set rng = ws.Range("A1:B10")' 应用筛选条件rng.AutoFilter Field:=1, Criteria1:="Value1"End Sub```上述代码将在A列和B列上进行筛选，只显示满足条件"Value1"的行。
VBA常用注释代码
VBA常用注释代码Sub 开启最近使用过的档案()MsgBox "显示最近使用过的第二个文件名称，并开启它"MsgBox Application.RecentFiles(2).NameApplication.RecentFiles(2).OpenEnd SubSub 内存容量()MsgBox "Excel可使用的内存大小为：" & Application.MemoryTotal MsgBox "Excel已使用的内存为：" & Application.MemoryUsedMsgBox "Excel剩余的内存大小为：" & Application.MemoryFree End SubSub 全屏幕模式()Dim gamen As BooleanMsgBox "将Excel的显示模式设为全屏幕"gamen = Application.DisplayFullScreenApplication.DisplayFullScreen = TrueMsgBox "回复原来的状态"Application.DisplayFullScreen = gamenEnd SubfileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")希望能将一个TXT文件自动分割到几个SHEET里面，如果它超过65536行Dim ResultStr As StringDim FileName As StringDim FileNum As IntegerDim Counter As DoubleFileName = Application.GetOpenFilenameIf FileName = "" Then EndFileNum = FreeFile()Open FileName For Input As #FileNumApplication.ScreenUpdating = FalseWorkbooks.Add Template:=xlWorksheetCounter = 1Do While Seek(FileNum) <= LOF(FileNum)Application.StatusBar = "Importing Row " & _Counter & " of text file " & FileNameLine Input #FileNum, ResultStrIf Left(ResultStr, 1) = "=" ThenActiveCell.Value = "'" & ResultStrElseActiveCell.Value = ResultStrEnd IfIf ActiveCell.Row = 65536 ThenActiveWorkbook.Sheets.AddElseActiveCell.Offset(1, 0).SelectEnd IfCounter = Counter + 1LoopCloseApplication.StatusBar = False如何用vba代码显示当前工作簿是只读状态还是可修改状态：MsgBox ThisWorkbook.ReadOnly欲判断单元格中是否是#N/A如何处理.如:If Range("F" & bl & "").Value = "#N/A" Then这样该单元格内容类型是否为字符串.不加引号报错.:Sub bb()Set testrng = [b1]If IsError(testrng) ThenIf testrng = CVErr(xlErrNA) ThenMsgBox "就是#N/A"ElseMsgBox "其他错误"End IfElseMsgBox "没有错误"End IfEnd SubSub UseFileDialogOpen()Dim lngCount As Long' Open the file dialogWith Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True.Show' Display paths of each file selectedFor lngCount = 1 To .SelectedItems.CountMsgBox .SelectedItems(lngCount)Next lngCountEnd WithEnd Sub从另外一个未打开的Excel文件中读取数据的函数下面这个函数调用XLM宏从未打开的工作簿中读取数据. 注意: 该函数不能用于公式.GetValue函数,需要以下四个变量path: 未打开的Excel文件的路径(e.g., "d:¥test") file: 文件名(e.g., "test.xls")sheet: 工作表的名称(e.g., "Sheet1")ref: 引用的单元格(e.g., "C4")Private Function GetValue(path, file, sheet, ref)' 从未打开的Excel文件中检索数据Dim arg As String' 确保该文件存在If Right(path, 1) <> "¥" Then path = path & "¥"If Dir(path & file) = "" ThenGetValue = "File Not Found"Exit FunctionEnd If' 创建变量arg = "'" & path & "[" & file & "]" & sheet & "'!" & _Range(ref).Range("A1").Address(, , xlR1C1)' 执行XLM 宏GetValue = ExecuteExcel4Macro(arg)End Function使用该函数:将该语句复制到VBA的模块中,然后,在适当的语句中调用该函数. 下面的例子显示D:¥test 下的文件test.xls 的Sheet1中的单元格”A1”的内容.Sub TestGetValue()p = "d:¥test"f = "test.xls"s = "Sheet1"a = "A1"MsgBox GetValue(p, f, s, a)End Sub下面还有一个例子.这个语句从一个未打开的文件中读取1200个数值(100行12列),并将结果填到当前工作表中.Sub TestGetValue2()p = "d:¥test "f = "test.xls"s = "Sheet1"Application.ScreenUpdating = FalseFor r = 1 To 100For c = 1 To 12a = Cells(r, c).AddressCells(r, c) = GetValue(p, f, s, a)Next cNext rApplication.ScreenUpdating = TrueEnd Sub说明: 如果工作簿处于隐藏状态,或者工作表是图表工作表,将会报错.在VBA中怎么象"我的电脑中的文件夹档"一样让用户自已选择路径和文件.选择文件：Application.GetopenFilename选择文件夹：1、Application.FileDialog(msoFileDialogFolderPicker)在H 列，从H3 开始，每隔3行分别输入 A 到H ！Application.ScreenUpdating = FalseDim arr(1 To 65536, 1 To 1), i As LongFor i = 3 To 65536 Step 4arr(i, 1) = Chr(((i - 3) ¥ 4) Mod 8 + 65)NextRange("h1:h65536") = arrApplication.ScreenUpdating = True有一單元格，我設置了格式為自動換行。
vba查找word中图和表的题注,设置格式,
vba查找word中图和表的题注,设置格式, '======================函数1======================Sub UpdateFiledStyle() '更新某个域所在⾏的格式，⽤于更新表或者图的标题极度有⽤Dim aFeild As FieldsDim str As StringFor Each aField In ActiveDocument.Fieldsstr = aField.Code.Text '直接取字符串，他的前后有个看不到的字符串，必须去掉才能⽐较str = Left(str, Len(str) - 1)str = Right(str, Len(str) - 1)If (str = "SEQ 图 \* ARABIC") Then'MsgBox ("找到域")'找到域的位置后，相当于光标定位到⾏，按End键，光标到最后，在Ctrl+Home，全选此⾏，再更改样式aField.SelectSelection.EndKey Unit:=wdLineSelection.HomeKey Unit:=wdLine, Extend:=wdExtendSelection.Style = ActiveDocument.Styles("图标题")End IfNext aFieldEnd Sub'======================函数3======================Sub UpdateFiledStyleLine() '去掉标题和域数字之间的空格Dim aFeild As FieldsDim str As String'Dim str2 As StringDim i As Integeri = 1For Each aField In ActiveDocument.Fields '.Item(0).str = aField.Code.Text '直接取字符串，他的前后有个看不到的字符串，必须去掉才能⽐较str = Left(str, Len(str) - 1)str = Right(str, Len(str) - 1)If (str = "SEQ 图 \* ARABIC") Then'MsgBox ("找到域")'选中域所在⾏，到⾸⾏，光标左移，选中前⾯所有⽂本，去掉空格aField.SelectSelection.MoveLeft Unit:=wdCharacter, Count:=1Selection.HomeKey Unit:=wdLine, Extend:=wdExtendDim strHead As StringstrHead = Selection.TextSelection.Text = Replace(strHead, " ", "")End IfNext aFieldEnd Sub'======================函数4======================Sub UpdateFiledStyleLine2() '去掉域数字和表名之间的多余空格'Call UpdateFiledStyleLineDim aFeild As FieldsDim str As StringFor Each aField In ActiveDocument.Fields '.Item(0).str = aField.Code.Text '直接取字符串，他的前后有个看不到的字符串，必须去掉才能⽐较str = Left(str, Len(str) - 1)str = Right(str, Len(str) - 1)If (str = "SEQ 图 \* ARABIC") Then'MsgBox ("找到域")'找到域的位置后，选中域，右移⼀个字符，将后⾯的全选，然后去掉所有空格，再在前⾯加⼀个空格aField.SelectDim strTail As StringSelection.MoveRight Unit:=wdCharacter, Count:=1Selection.EndKey Unit:=wdLine, Extend:=wdExtend '选中域后⾯所有⽂本Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtendstrTail = Selection.TextSelection.Text = " " & Replace(strTail, " ", "")End If Next aField End Sub。
使用VBA操作文件（12）：如何使用VBA查找文件
使用VBA操作文件（12）：如何使用VBA查找文件下面的代码主要介绍如何使用Windows API函数及内置的VBA 函数查找和列出文件。
当然，VBA也包含了用于查找和列出文件的Application.FileSearch对象。
方法1：使用Windows API步骤1 在VBE中，插入一个标准模块，并输入下面的代码：Declare Function FindFirstFile Lib "kernel32" Alias _"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _As WIN32_FIND_DATA) As LongDeclare Function FindNextFile Lib "kernel32"Alias "FindNextFileA" _(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongDeclare Function GetFileAttributes Lib "kernel32" Alias _"GetFileAttributesA" (ByVal lpFileName As String) As LongDeclare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _As LongDeclare Function FileTimeToLocalFileTime Lib "kernel32" _ (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As LongDeclare Function FileTimeToSystemTime Lib "kernel32" _(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) AsLongPublic Const MAX_PATH = 260Public Const MAXDWORD = &HFFFFPublic Const INVALID_HANDLE_VALUE = -1Public Const FILE_ATTRIBUTE_ARCHIVE = &H20Public Const FILE_ATTRIBUTE_DIRECTORY = &H10Public Const FILE_ATTRIBUTE_HIDDEN = &H2Public Const FILE_ATTRIBUTE_NORMAL = &H80Public Const FILE_ATTRIBUTE_READONLY = &H1Public Const FILE_ATTRIBUTE_SYSTEM = &H4Public Const FILE_ATTRIBUTE_TEMPORARY = &H100Type FILETIMEdwLowDateTime As LongdwHighDateTime As LongEnd TypeType WIN32_FIND_DATAdwFileAttributes As LongftCreationTime As FILETIMEftLastAccessTime As FILETIMEftLastWriteTime As FILETIMEnFileSizeHigh As LongnFileSizeLow As LongdwReserved0 As LongdwReserved1 As LongcFileName As String * MAX_PATHcAlternate As String * 14End TypeType SYSTEMTIMEwYear As IntegerwMonth As IntegerwDayOfWeek As IntegerwDay As IntegerwHour As IntegerwMinute As IntegerwSecond As IntegerwMilliseconds As IntegerEnd TypePublic Function StripNulls(OriginalStr As String) As StringIf (InStr(OriginalStr, Chr(0)) > 0) ThenOriginalStr = Left(OriginalStr, _InStr(OriginalStr, Chr(0)) - 1)End IfStripNulls = OriginalStrEnd Function步骤2 在VBE中插入一个用户窗体，如下图所示。
用VBA编制Access的查询程序VB-电脑资料
用VBA编制Access的查询程序VB-电脑资料用 VB A编制Access的查询程序 -------------------------------------------------------------------------------- 在 Access 中 ,要设计一个查询程序是十分快捷的，。
它提供的查询向导,可以一步步地引导程序员迅速建立查询 ,并可用 SQL 及 Design 方式查看用VB A编制A clearcase/" target="_blank" >ccess的查询程序--------------------------------------------------------------------------------在Access 中,要设计一个查询程序是十分快捷的。
它提供的查询向导,可以一步步地引导程序员迅速建立查询,并可用SQL 及Design 方式查看。
另外,它所提供的QueryDefs 对象,则可以方便地用VBA 编制出基于特殊要求的查询程序。
下面三个例子就是用VBA 实现查询功能的程序。
简单查询在FORM. mainform上定义按钮cmd－qry－status－1,当鼠标点击按钮它时,将创建Query qry－status－1 并打开FORM. frm－qry －status－1。
定义FORM. frm－qry－status－1 的数据源为 Query qry－status－1。
程序1：Private Sub cmd－qry－status－1－Click()Dim qry－tmp As QueryDefDim dbs－itsr As DatabaseDim strsql As StringDim stDocName As StringDim stLinkCriteria As StringSet dbs－itsr = CurrentDb()strsql = ″SELECT ＊FROM Request WHERE(((Request.Status)=1));″For Each qry－tmp In dbs－itsr.QueryDefsIf qry－ = ″qry－status－1″Thendbs－itsr.QueryDefs.Delete qry－End IfNext qry－tmpSet qry－tmp = dbs－itsr.CreateQueryDef(″qry－status－1″, strsql)On Error GoTo Err－cmd－q－y－status－1－ClickstDocName =″frm－qry－status－1″DoCmd.OpenForm. stDocName, , , stLinkCriteriaExit－cmd－qry－status－1－Click:For Each qry－tmp In dbs－itsr.QueryDefsIf qry－ =″qry－status－1″ Thendbs－itsr.QueryDefs.Delete qry－End IfNext qry－tmpExit SubErr－cmd－qry－status－1－Click:MsgBox Err.DescriptionResume Exit－cmd－qry－status－1－ClickEnd Sub参数查询当要求查询条件可以变更时,需要设计参数查询。
ExcelVBA解读（41）：藏得再好也能找到——使用Find方法实现查找
ExcelVBA解读（41）：藏得再好也能找到——使用Find方法实现查找生活中有许多怪现象，例如，我就经常碰到这样的事情，当我想要某件东西时，找半天也总是找不到，可不想要它时，却冒了出来，你说气不气人！找东西绝不是一件有趣的事儿！Excel考虑得很周全，为你准备了查找功能，能够在大量的工作表数据中找出特定的数据。
下面的图演示了我们在Excel中常用的查找操作：在图示工作表中，我们要查找内容为“1”的单元格，在“查找与替换”对话框的“查找内容”中输入“1”，单击“查找全部”按钮，即可显示所查找到的详细信息，并且工作表中会选择查找到的第一个单元格。
如果单击对话框中“查找下一个”按钮，那么活动单元格会在查找到的单元格中循环移动。
我们来看看宏录制器录制上述操作后生成的代码。
如果仅单击“查找全部”按钮，宏录制器不会生成任何代码，只有当单击“相找下一个”按钮时，宏录制器才会录制代码。
我单击了“查找下一个”按钮三次，即依次选择包含“1”的单元格A1、D2、B3。
录制的代码如下：Sub 宏5()'' 宏5 宏''Cells.Find(What:='1',After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _xlPart, SearchOrder:=xlByRows,SearchDirection:=xlNext, MatchCase:=False _, MatchByte:=False,SearchFormat:=False).ActivateCells.FindNext(After:=ActiveCell).ActivateCells.FindNext(After:=ActiveCell).ActivateEnd Sub与录制的操作相对照，分析录制的代码。
Find方法负责在工作表单元格区域中执行查找，FindNext方法向指定的单元格后继续进行查找。