Excel VBA常用技巧代码

1.删除重复行 (1)2.ActiveX控件的相关操作 (2)3.单元格内容匹配 (2)4.单元格填充公式 (3)5.弹出打开对话框 (3)6.操作文件夹下的所有工作簿 (3)7.获取数据区域的最后一行和最后一列 (4)8.获取列的字母顺序[A~IV] (4)9.自定义函数返回数组并填充至单元格区域 (4)10.绘制曲线图 (5)11.单元格区域拷贝 (6)12.操纵数据库（查、增、删、改） (6)13.待定XX (7)1.删除重复行关键字：[a65536].End(xlUp).Row、Offset()、相关双层循环Sub RemoveDuplicate()'删除重复行For i = [a65536].End(xlUp).Row - 1 To 1 Step -1 '按倒叙删除For j = [a65536].End(xlUp).Row To i + 1 Step -1If Cells(i, 1).Value = Cells(j, 1).Value ThenRows(i).DeleteEnd IfNextNextEnd SubSub RemoveItem()'删除相邻重复，但不删除隔行重复Dim i As LongWith Range("A2") '以A2为基准进行单元格偏移Do While .Offset(i, 0)If .Offset(i, 0).Value = .Offset(i - 1, 0).Value Then .Offset(i, 0).EntireRow.Deletei = i + 1LoopEnd WithEnd Sub2.ActiveX控件的相关操作关键字：ActiveX、OLEObjects、ActiveSheet.OLEObjects 遍历控件Dim c As ObjectFor Each c In ActiveSheet.OLEObjectsIf = "ComboBox" & i Then' …………..ElseIf = "CheckBox" & i Then' …………..End IfNext c测试控件排布.xls附件：3.单元格内容匹配关键字：Exit For、.Interior.ColorIndex、互不相关双层循环Sub Match()Dim i, j As IntegerFor i = 1 To [a65536].End(xlUp).RowFor j = 1 To [b65536].End(xlUp).RowIf Cells(i, 1).Value = Cells(j, 2).Value ThenCells(i, 1).Interior.ColorIndex = j + iCells(j, 2).Interior.ColorIndex = j + iExit For '仅匹配第一次End IfNext jNext iEnd SubSub UnMatch()Dim i, j As IntegerFor i = 1 To [F65536].End(xlUp).RowFor j = 1 To [G65536].End(xlUp).RowIf Cells(i, 6).Value = Cells(j, 7).Value ThenExit For '当找到有匹配的时候退出，进入下一个记录查找Else'当找遍所有，但未找到(j=循环上限)，给出处理If j = [G65536].End(xlUp).Row ThenCells(i, 6).Interior.ColorIndex = j + iEnd IfEnd IfNext jNext i查找匹配.xls附件：4.单元格填充公式关键字：公式、. Formula、. FormulaR1C1Cells(1, 1).Formula = "=B1+C1"Cells(2, 1).FormulaR1C1 = "=R[-1]C[1]+R[-1]C[2]" '通过偏移的方式设置5.弹出打开对话框关键字：GetOpenFilename(过滤器, 过滤索引, 窗口标题, , 选择多个)、.FileExists()File=Application.GetOpenFilename("文本文件,*.txt,Excel文件,*.xls,所有文件,*.*", 2, "打开Excel", , False) Cells(1, 1).Value = File ‘未选择文件时返回FalseDim myfile As ObjectSet myfile = CreateObject("Scripting.FileSystemObject")If myfile.FileExists(File) = False Then‘………….当文件不存在时End If6.操作文件夹下的所有工作簿关键字：Do While … Loop、遍历工作簿Sub OperateWorkbooks()Application.ScreenUpdating = FalseDim lj As String '获取当前文件夹路径Dim dirname As String '目标工作簿名称Dim nm As String '工具工作簿（有代码存放）名称lj = ActiveWorkbook.Pathnm = dirname = Dir(lj & "\*.xls*")Do While dirname <> ""If dirname <> nm ThenWorkbooks(dirname).Sheets(1).Activate ''.......对目标工作簿的第一个sheet激活，并进行相关操作Workbooks(dirname).Close True '关闭并保存目标工作簿End Ifdirname = Dir '获取下一个目标工工作簿名称LoopApplication.ScreenUpdating = TrueEnd Sub7.获取数据区域的最后一行和最后一列关键字：.End(xlUp).Row、.End(xlToRight).Column rowIndex = [A1].End(xlUp).RowcolumnIndex = [A1].End(xlToRight).Column8.获取列的字母顺序[A~IV]关键字：.Address、Split()Cells(1, i).Value = Split(Cells(1, i).Address, "$")(1)9.自定义函数返回数组并填充至单元格区域关键字：二维数组、单元格区域Function ColumnSum(ColumnA As Variant, ColumnB As 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 ntemp(i, 1) = A(i, 1) * B(i, 1)Next iColumnSum = tempEnd Function10.绘制曲线图关键字：ChartObjects、SeriesCollection、设置曲线样式坐标轴刻度范围遍历所有的曲线图，并删除数据系列For i = 1 To ActiveSheet.ChartObjects.countActiveSheet.ChartObjects(i).ActivateFor Each sc In ActiveChart.SeriesCollectionsc.DeleteNext scNext i对指定的图添加数据系列ActiveChart.ChartType = xlXYScatterLinesNoMarkersFor i = 1 To 10ActiveChart.SeriesCollection.NewSeriesActiveChart.SeriesCollection(i).Name = "=Sheet1!" & rngName.Offset(0, i).AddressActiveChart.SeriesCollection(i).XValues = "=Sheet1!" & rngXValue.Offset(0, i).AddressActiveChart.SeriesCollection(i).Values = "=Sheet1!" & rngYValue.Offset(0, i).AddressNext i对在图中添加竖线（横坐标相同，纵坐标范围为最小值至最大值之间）ActiveChart.SeriesCollection(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(xlCategory).MinimumScaleIsAuto = TrueActiveChart.Axes(xlCategory).MaximumScaleIsAuto = TrueActiveChart.Axes(xlValue).MinimumScaleIsAuto = TrueActiveChart.Axes(xlValue).MaximumScaleIsAuto = TrueActiveChart.Axes(xlValue).MinimumScale = 1ActiveChart.Axes(xlValue).MaximumScale = 1011.单元格区域拷贝关键字：Range对象、单元格格式、单元格数值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.RecordsetSub OperateAccess()edRange.ClearDim conn As ObjectDim rds As ObjectSet conn = CreateObject("ADODB.Connection")Set rds = CreateObject("ADODB.Recordset")Dim connStr As String, sqlStr As String'查询远程SQL Sever数据库：数据源为IP地址，输入用户名和密码，Initial Catalog为初始数据库名称'connStr = "Provider=SQLOLEDB.1;Persist Security Info=True;Data Source=192.168.18.52; 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 where name in ('周晓春', '胡怀金','汪林芳')" '查询sqlStr = "select ,a.Age,a.Sex,b.workAge,b.salary,b.Place from [Human] as a, [Work] as b where = 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.Open sqlStr, conn '可以以用这句，但优先使用下面一句,语义更明确Set rds = conn.Execute(sqlStr)For col = 0 To rds.fields.Count - 1Range("A1").Offset(0, col).Value = rds.fields(col).Name '获取字段名，即列标题NextRange("A1").Offset(1, 0).CopyFromRecordset rdsconn.CloseSet conn = NothingSet rds = NothingEnd Sub13.待定XX。