(word完整版)Excel VBA常用技巧代码

(word完整版)Excel VBA常用技巧代码

1. 删除重复行 .........................................................................................................................................1

2. ActiveX控件的相关操作 ........................................................ 1

3. 单元格内容匹配 ................................................................ 2

4。 单元格填充公式 ................................................................ 3

5。 弹出打开对话框 ................................................................ 3

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

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

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

9. 自定义函数返回数组并填充至单元格区域 .......................................... 4

10. 绘制曲线图 .................................................................. 5

11. 单元格区域拷贝 .............................................................. 5

12. 操纵数据库(查、增、删、改） ................................................. 6

13。 待定XX ...................................................................... 6

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”） ’以A2为基准进行单元格偏移

Do While .Offset(i, 0)

If .Offset（i， 0)。Value = .Offset（i — 1, 0）。Value Then 。Offset（i, 0）.

i = i + 1

Loop

End With

End Sub

2.

ActiveX控件的相关操作

关键字：

ActiveX、OLEObjects、ActiveSheet。OLEObjects

(word完整版)Excel VBA常用技巧代码

遍历控件

Dim c As Object

For Each c In ects

If = ”ComboBox” & i Then

’ …………。.

ElseIf = ”CheckBox” ＆ i Then

' …………。。

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).ndex = j + i

Cells（j， 2）。ndex = 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).ndex = j + i

End If

End If

Next j

Next i

(word完整版)Excel VBA常用技巧代码

查找匹配.xls附件:

4.

单元格填充公式

关键字：

公式、。 Formula、。 FormulaR1C1

Cells（1, 1).Formula = ”=B1+C1"

Cells(2， 1）.FormulaR1C1 = ”=R[-1］C[1]+R[-1]C［2]" ’通过偏移的方式设置

5.

弹出打开对话框

关键字：

GetOpenFilename(过滤器, 过滤索引， 窗口标题, , 选择多个)、。FileExists（）

File=nFilename（”文本文件，＊.txt,Excel文件,＊。xls,所有文件,＊.＊"， 2, ”打开Excel"， ,

False）

Cells（1, 1）。Value = File ‘未选择文件时返回False

Dim myfile As Object

Set myfile = CreateObject（”stemObject”）

If ists（File) = False Then

‘………….当文件不存在时

End If

6.

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

关键字：

Do While … Loop、遍历工作簿

Sub OperateWorkbooks()

Updating = False

Dim lj As String '获取当前文件夹路径

Dim dirname As String ’目标工作簿名称

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

lj =

nm = ActiveWorkbook。Name

dirname = Dir(lj & "*。xls*"）

Do While dirname <> ""

If dirname <〉 nm Then

(word完整版)Excel VBA常用技巧代码

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, ”＄”)(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 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

(word完整版)Excel VBA常用技巧代码

10.

绘制曲线图

关键字：

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

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

For i = 1 To bjects。count

ActiveSheet。ChartObjects（i）.Activate

For Each sc In ActiveChart。SeriesCollection

sc。Delete

Next sc

Next i

对指定的图添加数据系列

ype = xlXYScatterLinesNoMarkers

For i = 1 To 10

ActiveChart。SeriesCollection。NewSeries

Collection（i)。Name = ”=Sheet1！” & (0， i）.Address

Collection(i)。XValues = "=Sheet1！" & （0， i）。Address

Collection(i）.Values = ”=Sheet1!" & (0， i).Address

Next i

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

Collection(1）.XValues = ”=｛” & point ＆ "，" & point ＆ ”}”

ActiveChart。SeriesCollection(1）。Values = ”={” & maxval ＆ ”," ＆ minval & ”｝"

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

Collection(i).Select

With Selection。

。Visible = msoTrue

。Weight = 1

End With

ActiveChart。ChartTitle。Text

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

（xlCategory）.MinimumScaleIsAuto = True

（xlCategory）。MaximumScaleIsAuto = True

（xlValue).MinimumScaleIsAuto = True

(xlValue)。MaximumScaleIsAuto = True

ActiveChart。Axes（xlValue）。MinimumScale = 1

(xlValue）.MaximumScale = 10

11.

单元格区域拷贝

关键字：

Range对象、单元格格式、单元格数值

Set Rng = （”A1：A4"） ’将单元格区域存储到Range对象

（"C1:C4”) '直接拷贝

（”D1：D4”）。Interior。Color = or。Color '只传递底纹颜色

("D1：D4"）。Value = Rng。Value ’只传递数值

(word完整版)Excel VBA常用技巧代码

ontents ’清楚内容，注意Range对象为引用类型，当清除内容后，Sheet1中的内容也被清除

12.

操纵数据库（查、增、删、改)

关键字：

tion、ADODB。Recordset

Sub OperateAccess()

nge。Clear

Dim conn As Object

Dim rds As Object

Set conn = CreateObject(”tion")

Set rds = CreateObject("set”)

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。Name，a。Age,,e，, from [Human] as a, ［Work] as b where

a。Name=b。Name order by desc" '两张表同时查询，并按设定的视图给出

’sqlStr = ”insert into human(Name，Age，Sex） values（'小春哥'，'11’,'1’)” '增加

’sqlStr = "update human set name='周晓春' where name='小春哥’” ’修改

’sqlStr = ”delete from human where name=’周晓春'" ’删除

’ sqlStr, conn '可以以用这句,但优先使用下面一句,语义更明确

Set rds = e（sqlStr）

For col = 0 To 。Count — 1

Range(”A1”）.Offset（0， col)。Value = (col）。Name ’获取字段名,即列标题

Next

Range(”A1”）.Offset（1, 0)。CopyFromRecordset rds

conn。Close

Set conn = Nothing

Set rds = Nothing

End Sub

13.

待定XX