VBA程序新建起手式模板

Sub qigemingzi()       '起个名字

'--------------------------------

Sheets("表名").Select  '选中一个表

Dim tms

tms = Timer                                      '获取当前时间

Application.ScreenUpdating = False               '关闭屏幕更新


kshs = 2                                         '定义开始行数

jshs = Sheets("表名").[A65536].End(xlUp).Row     '获取数据行数

jsl = Split(Sheets("表名").[IV3].End(xlToLeft).Address, "$")(1) '获取结束列标字母


ReDim shuchu(1 To jshs, 1 To jsls)           '定义输出数组

'相关数据写入数组

'--------------------------------

Dim shujuarr                                 '定义数据数组

shujuarr = Range("a" & kshs & ":a" & jshs)   '列数据装入数组


'字典相关操作样例

'--------------------------------

Dim dic As Object                              '定义字典

Set dic = CreateObject("Scripting.Dictionary") '引用字典


For i = 1 To jshs - 1

   Key = shujuarr(i, 1)

  Item = shujuarr(i, 3)

  If dic.exists(Key) Then                     '判断字典是否存在KEY键

  dic.Item(Key) = dic.Item(Key) & "," & Item  '存在则变更KEY对应的值

  Else

  dic.Add Key, Item                           '不存在则添加键值

  End If

Next


For i = 1 To jshs - 1

vkey = shujuarr(i, 2)

shuchu(i) = dic.Item(vkey)                    '查找Vkey返回值。

Next


'输出数组结果回写单元格

'--------------------------------

Range("DC" & kshs & ":" & jsl & jshs) = shuchu           '输出数据回写单元格，如需转置则Application.Transpose(shuchu)

Application.ScreenUpdating = True

MsgBox "更新完成,用时" & Format(Timer - tms, "0.0000s")  '计算程序用时

End Sub