vba有哪些具体案例的应用？

工作需要，自学了一点VBA，目前算是4类应用吧。

一、自定义函数。

如计算Unif，使用excel原来的公式，则Unif=(Max(range)-Min(range))/(Max(range)+Min(range))，非常麻烦。

自定义一个函数unif，则Unif＝unif(range)就可以了。

二、自定义工具栏。

其实我是写一个vba程序，然后添加到工具栏，不是复杂的那种。但非常方便的。

比如使用透视表时，添加的数值中的项要么为计数项，要么为求和项的，但我平时是看平均值的，当然可以自己改，但是有时候看的项目比较多，一个个改太麻烦了。

于是，我写了程序，针对当前Activesheet中的透视表，自动将数值变为平均值。然后把这个宏添加到“设计”中，每次编辑透视表就可以点一下自动变更啦。

三、用户窗体。

这个也编了一个，按个按键，d出来一个窗体，就和软件一样，然后可以各种 *** 作。有点复杂。

四、数据汇总用的。

就是自动将多个excel合并，汇总数据什么的。一般就是建个xlam模板，然后应用。很复杂。

个人遇到的基本就是这些情况。

Sub iCopy()

Dim sh As Worksheet, c As Range, arr1, arr2, r&, rn&

Set sh = Worksheets("Sheet1") '表1（源数据表）

Set c = Worksheets("Sheet2").Range("A1") '表2（结果表） + 结果位置（第1个单元格）

With sh ' *** 作 表1

r = .Cells(65536, 1).End(xlUp).Row'最后行位置

arr1 = .Cells(1, 1).Resize(1, 2) '第1行数据，存入数组arr1

arr2 = .Cells(2, 1).Resize(r - 1, 2) '第1行以下的所有数据，存入数组arr2

End With

With c.Resize(1, 2) ' *** 作 结果位置，并扩展为 1行2列

.EntireColumn.ClearContents '清理 结果位置 所在列

rn = 1'结果位置 相对于 c 单元格的行位置

For r = LBound(arr2) To UBound(arr2) '循环

If arr2(r, 1) <>arr1(1, 1) And arr2(r, 2) = arr1(1, 2) Then '判断

.Rows(rn) = arr1'复制 表1 第1行数据

.Rows(rn + 1) = Array(arr2(r, 1), arr2(r, 2)) '复制 表1 第r行数据

rn = rn + 2 '结果位置 向下移动2行

End If

Next

End With

MsgBox "完成！"

End Sub

---