Excel VBA常用技巧代码

1、1.删除重复行12.ActiveX控件的相关操作23.单元格内容匹配24.单元格填充公式35.弹出打开对话框36.操作文件夹下的所有工作簿37.获取数据区域的最后一行和最后一列48.获取列的字母顺序AIV49.自定义函数返回数组并填充至单元格区域410.绘制曲线图511.单元格区域拷贝612.操纵数据库（查、增、删、改）613.待定XX71. 删除重复行关键字： a65536.End(xlUp).Row、Offset()、相关双层循环Sub RemoveDuplicate()删除重复行 For i = a65536.End(xlUp).Row - 1 To 1 Step -1 按倒叙删除 Fo

2、r j = a65536.End(xlUp).Row To i + 1 Step -1 If Cells(i, 1).Value = Cells(j, 1).Value Then Rows(i).Delete End If Next NextEnd SubSub RemoveItem()删除相邻重复，但不删除隔行重复 Dim i As Long With Range(A2) 以A2为基准进行单元格偏移 Do While .Offset(i, 0) If .Offset(i, 0).Value = .Offset(i - 1, 0).Value Then .Offset(i, 0).Entire

3、Row.Delete i = i + 1 Loop End WithEnd Sub2. ActiveX控件的相关操作关键字： ActiveX、OLEObjects、ActiveSheet.OLEObjects遍历控件 Dim c As Object For Each c In ActiveSheet.OLEObjects If c.Name = ComboBox & i Then . ElseIf c.Name = CheckBox & i Then . End If Next c附件：3. 单元格内容匹配关键字： Exit For、.Interior.ColorIndex、互不相关双层循环S

4、ub Match() Dim i, j As Integer For i = 1 To a65536.End(xlUp).Row For j = 1 To b65536.End(xlUp).Row If Cells(i, 1).Value = Cells(j, 2).Value Then Cells(i, 1).Interior.ColorIndex = j + i Cells(j, 2).Interior.ColorIndex = j + i Exit For 仅匹配第一次 End If Next j Next iEnd SubSub UnMatch() Dim i, j As Intege

5、r For i = 1 To F65536.End(xlUp).Row For j = 1 To G65536.End(xlUp).Row If Cells(i, 6).Value = Cells(j, 7).Value Then Exit For 当找到有匹配的时候退出，进入下一个记录查找 Else 当找遍所有，但未找到(j=循环上限)，给出处理 If j = G65536.End(xlUp).Row Then Cells(i, 6).Interior.ColorIndex = j + i End If End If Next j Next i附件：4. 单元格填充公式关键字： 公式、. F

6、ormula、. FormulaR1C1Cells(1, 1).Formula = =B1+C1Cells(2, 1).FormulaR1C1 = =R-1C1+R-1C2 通过偏移的方式设置5. 弹出打开对话框关键字： GetOpenFilename(过滤器, 过滤索引, 窗口标题, , 选择多个)、.FileExists()File=Application.GetOpenFilename(文本文件,*.txt,Excel文件,*.xls,所有文件,*.*, 2, 打开Excel, , False)Cells(1, 1).Value = File 未选择文件时返回FalseDim myfil

7、e As ObjectSet myfile = CreateObject(Scripting.FileSystemObject)If myfile.FileExists(File) = False Then.当文件不存在时End If6. 操作文件夹下的所有工作簿关键字： Do While Loop、遍历工作簿Sub OperateWorkbooks() Application.ScreenUpdating = False Dim lj As String 获取当前文件夹路径 Dim dirname As String 目标工作簿名称 Dim nm As String 工具工作簿（有代码存放）

8、名称 lj = ActiveWorkbook.Path nm = ActiveWorkbook.Name dirname = Dir(lj & *.xls*) Do While dirname If dirname nm Then Workbooks(dirname).Sheets(1).Activate .对目标工作簿的第一个sheet激活，并进行相关操作 Workbooks(dirname).Close True 关闭并保存目标工作簿 End If dirname = Dir 获取下一个目标工工作簿名称 Loop Application.ScreenUpdating = TrueEnd S

9、ub7. 获取数据区域的最后一行和最后一列关键字： .End(xlUp).Row、.End(xlToRight).ColumnrowIndex = A1.End(xlUp).RowcolumnIndex = A1.End(xlToRight).Column8. 获取列的字母顺序AIV关键字： .Address、Split()Cells(1, i).Value = Split(Cells(1, i).Address, $)(1)9. 自定义函数返回数组并填充至单元格区域关键字： 二维数组、单元格区域Function ColumnSum(ColumnA As Variant, ColumnB As

10、 Variant) As Variant注意首先选中合适大小的单元格区域，输入公式后按Ctrl+Shift+Enter的方式插入数组Dim n As Integer, A As Variant, B As Variant, temp As VariantA = ColumnAB = ColumnBn = UBound(A)ReDim temp(1 To n, 1 To 1)For i = 1 To n temp(i, 1) = A(i, 1) * B(i, 1)Next iColumnSum = tempEnd Function10. 绘制曲线图关键字： ChartObjects、Series

11、Collection、设置曲线样式坐标轴刻度范围遍历所有的曲线图，并删除数据系列For i = 1 To ActiveSheet.ChartObjects.count ActiveSheet.ChartObjects(i).Activate For Each sc In ActiveChart.SeriesCollection sc.Delete Next scNext i对指定的图添加数据系列ActiveChart.ChartType = xlXYScatterLinesNoMarkersFor i = 1 To 10 ActiveChart.SeriesCollection.NewSeri

12、es ActiveChart.SeriesCollection(i).Name = =Sheet1! & rngName.Offset(0, i).Address ActiveChart.SeriesCollection(i).XValues = =Sheet1! & rngXValue.Offset(0, i).Address ActiveChart.SeriesCollection(i).Values = =Sheet1! & rngYValue.Offset(0, i).AddressNext i对在图中添加竖线（横坐标相同，纵坐标范围为最小值至最大值之间）ActiveChart.Ser

13、iesCollection(1).XValues = = & point & , & point & ActiveChart.SeriesCollection(1).Values = = & maxval & , & minval & 设置数据系列的线条样式及图表标题ActiveChart.SeriesCollection(i).SelectWith Selection.Format.Line .Visible = msoTrue .Weight = 1End WithActiveChart.ChartTitle.Text坐标轴范围设置自动或指定范围ActiveChart.Axes(xlCat

14、egory).MinimumScaleIsAuto = TrueActiveChart.Axes(xlCategory).MaximumScaleIsAuto = TrueActiveChart.Axes(xlValue).MinimumScaleIsAuto = TrueActiveChart.Axes(xlValue).MaximumScaleIsAuto = TrueActiveChart.Axes(xlValue).MinimumScale = 1ActiveChart.Axes(xlValue).MaximumScale = 1011. 单元格区域拷贝关键字： Range对象、单元格

15、格式、单元格数值Set Rng = Sheet1.Range(A1:A4) 将单元格区域存储到Range对象Rng.Copy Sheet2.Range(C1:C4) 直接拷贝Sheet3.Range(D1:D4).Interior.Color = Rng.Interior.Color 只传递底纹颜色Sheet3.Range(D1:D4).Value = Rng.Value 只传递数值Rng.ClearContents 清楚内容，注意Range对象为引用类型，当清除内容后，Sheet1中的内容也被清除12. 操纵数据库（查、增、删、改）关键字： ADODB.Connection、ADODB.Re

16、cordsetSub OperateAccess() ActiveSheet.UsedRange.Clear Dim conn As Object Dim rds As Object Set conn = CreateObject(ADODB.Connection) Set rds = CreateObject(ADODB.Recordset) Dim connStr As String, sqlStr As String 查询远程SQL Sever数据库：数据源为IP地址，输入用户名和密码，Initial Catalog为初始数据库名称connStr = Provider=SQLOLEDB.

17、1;Persist Security Info=True;Data Source=2; Password=111111; User ID = sa;Initial Catalog=LCMN 查询本地Access数据库：一般只需要指定数据源的路径 connStr = Provider = Microsoft.Jet.OLEDB.4.0;Persist Security Info=True;Data Source= & ActiveWorkbook.Path & test.mdb conn.Open connStr sqlStr = select * from human

18、where name in (周晓春, 胡怀金,汪林芳) 查询 sqlStr = select a.Name,a.Age,a.Sex,b.workAge,b.salary,b.Place from Human as a, Work as b where a.Name=b.Name order by b.salary desc 两张表同时查询，并按设定的视图给出 sqlStr = insert into human(Name,Age,Sex) values(小春哥,11,1) 增加 sqlStr = update human set name=周晓春 where name=小春哥 修改 sqlStr = delete from human where name=周晓春 删除 rds