Excel VBA常用技巧代码

1. 2. 3. 4. 5. 6. 7. 8. 9. 10. 11. 12. 13.

删除重复行 ....................................................................................................................................................... 1 ActiveX控件的相关操作 ................................................................................................................................. 2 单元格内容匹配 ............................................................................................................................................... 2 单元格填充公式 ............................................................................................................................................... 3 弹出打开对话框 ............................................................................................................................................... 3 操作文件夹下的所有工作簿 ........................................................................................................................... 3 获取数据区域的最后一行和最后一列 ........................................................................................................... 4 获取列的字母顺序[A~IV] ............................................................................................................................... 4 自定义函数返回数组并填充至单元格区域 ................................................................................................... 4 绘制曲线图 ................................................................................................................................................... 5 单元格区域拷贝 ........................................................................................................................................... 6 操纵数据库（查、增、删、改） ............................................................................................................... 6 待定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 -1 If Cells(i, 1).Value = Cells(j, 1).Value Then Rows(i).Delete End If Next Next End Sub

Sub RemoveItem()

'删除相邻重复，但不删除隔行重复 Dim i As Long

With Range(\以A2为基准进行单元格偏移 Do While .Offset(i, 0)

If .Offset(i, 0).Value = .Offset(i - 1, 0).Value Then .Offset(i, 0).EntireRow.Delete i = i + 1 Loop End With End Sub

2. ActiveX控件的相关操作

关键字： ActiveX、OLEObjects、ActiveSheet.OLEObjects

遍历控件

Dim c As Object

For Each c In ActiveSheet.OLEObjects If c.Name = \ ' …………..

ElseIf c.Name = \ ' ………….. End If Next c

测试控件排布.xls附件：

3. 单元格内容匹配

关键字： Exit For、.Interior.ColorIndex、互不相关双层循环

Sub 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 i End Sub

Sub UnMatch()

Dim i, j As Integer

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

查找匹配.xls附件：

4. 单元格填充公式

关键字： 公式、. Formula、. FormulaR1C1

Cells(1, 1).Formula = \

Cells(2, 1).FormulaR1C1 = \通过偏移的方式设置

5. 弹出打开对话框

关键字： GetOpenFilename(过滤器, 过滤索引, 窗口标题, , 选择多

个)、.FileExists()

File=Application.GetOpenFilename(\文本文件,*.txt,Excel文件,*.xls,所有文件,*.*\打开Excel\Cells(1, 1).Value = File ‘未选择文件时返回False Dim myfile As Object

Set myfile = CreateObject(\If myfile.FileExists(File) = False Then ‘………….当文件不存在时 End If

6. 操作文件夹下的所有工作簿

关键字： Do While … Loop、遍历工作簿

Sub OperateWorkbooks()

Application.ScreenUpdating = False

Dim lj As String '获取当前文件夹路径 Dim dirname As String '目标工作簿名称

Dim nm As String '工具工作簿（有代码存放）名称

lj = ActiveWorkbook.Path nm = ActiveWorkbook.Name dirname = Dir(lj & \

Do While dirname <> \ If dirname <> nm Then

Workbooks(dirname).Sheets(1).Activate '

'.......对目标工作簿的第一个sheet激活，并进行相关操作 Workbooks(dirname).Close True '关闭并保存目标工作簿 End If

dirname = Dir '获取下一个目标工工作簿名称 Loop

Application.ScreenUpdating = True End Sub

7. 获取数据区域的最后一行和最后一列

关键字： .End(xlUp).Row、.End(xlToRight).Column

rowIndex = [A1].End(xlUp).Row

columnIndex = [A1].End(xlToRight).Column

8. 获取列的字母顺序[A~IV]

关键字： .Address、Split()

Cells(1, i).Value = Split(Cells(1, i).Address, \

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 Variant A = ColumnA B = ColumnB n = 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 i

ColumnSum = temp End Function

10. 绘制曲线图

关键字： ChartObjects、SeriesCollection、设置曲线样式坐标轴刻度范围

遍历所有的曲线图，并删除数据系列

For i = 1 To ActiveSheet.ChartObjects.count ActiveSheet.ChartObjects(i).Activate For Each sc In ActiveChart.SeriesCollection sc.Delete Next sc Next i

对指定的图添加数据系列

ActiveChart.ChartType = xlXYScatterLinesNoMarkers For i = 1 To 10

ActiveChart.SeriesCollection.NewSeries

ActiveChart.SeriesCollection(i).Name = \ ActiveChart.SeriesCollection(i).XValues = \ ActiveChart.SeriesCollection(i).Values = \Next i

对在图中添加竖线（横坐标相同，纵坐标范围为最小值至最大值之间）

ActiveChart.SeriesCollection(1).XValues = \ActiveChart.SeriesCollection(1).Values = \

设置数据系列的线条样式及图表标题

ActiveChart.SeriesCollection(i).Select With Selection.Format.Line .Visible = msoTrue .Weight = 1 End With

ActiveChart.ChartTitle.Text

坐标轴范围设置自动或指定范围

ActiveChart.Axes(xlCategory).MinimumScaleIsAuto = True ActiveChart.Axes(xlCategory).MaximumScaleIsAuto = True ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True ActiveChart.Axes(xlValue).MinimumScale = 1 ActiveChart.Axes(xlValue).MaximumScale = 10

本文来源：https://www.bwwdw.com/article/7lev.html