楼主
kevinchengcw |
如果需要对比数据列的数据列数多而且列数值不固定，按照常规写法通常会要写出长长的代码，下面介绍一种可以有效简缩代码的方式：将对应列及列数值放入数组调用。同时配以字典查找重复的方式可以用于快速统计此类问题，代码如下：
- Sub test()
- Dim Dic, Arr, Col, Wid
- Dim M, N, I, T, C As Long
- Dim Str As String
- Application.ScreenUpdating = False '关闭屏幕刷新，加快处理速度
- Set Dic = CreateObject("scripting.dictionary") '建立字典用于存放源数据
- For N = 2 To Cells(Rows.Count, 1).End(3).Row '循环源数据区各行
- T = WorksheetFunction.CountBlank(Cells(N, 1).Resize(1, 6)) '判断源数据区的6列里空了几个单元格（因源数据区是用公式生成的，故用counta会判断不准确）
- Dic.Add N - 1, Join(Application.Transpose(Application.Transpose(Cells(N, 1).Resize(1, 6 - T).Value)), ",") '将源数据有值的区域用join函数串接后添加到字典中
- Next N
- Col = Array(8, 26, 36, 44, 49) '建立要分析的数据列起始列号的数组
- Wid = Array(5, 6, 4, 3, 2) '建立要分析的各数据列列数的数组
- Arr = Dic.keys '将字典的keys赋值给字典，方便取用
- For N = 3 To Range(Cells(1, 8), Cells(Rows.Count, Columns.Count)).SpecialCells(xlCellTypeLastCell).Row '循环要判断的数据区开始行到整个区域的最后一行
- For C = LBound(Col) To UBound(Col) '取出数据区各个数据列的起始列号
- I = 0 '初始化记录重复数量的变量的值为0
- T = WorksheetFunction.CountA(Cells(N, Col(C)).Resize(1, Wid(C))) '判断对应数据列的数据个数
- If T > 0 Then '如果数据列的当前行不为空，则进行下面判断
- Str = Join(Application.Transpose(Application.Transpose(Cells(N, Col(C)).Resize(1, Wid(C)))), ",") '将数据列当前行的数据用join串接
- For M = LBound(Arr) To UBound(Arr) '与字典中的各个item项进行比较
- If Str = Dic(Arr(M)) Then I = I + 1 '如果与item项值相等，则重复的记录加1
- Next M
- Cells(N, Col(C)).Offset(0, Wid(C)) = I '将最终的比较结果写到记录个数的单元格中
- End If
- Next C '循环到下一数据列
- Next N '下一行数据
- Application.ScreenUpdating = True '打开屏幕刷新
- MsgBox "处理完成", vbOKOnly, "" '显示提示消息
- End Sub
以上为统计完全一致的情况的代码，将判断语句改成下面这句即可以判断包含的情况了
- If Dic(Arr(M)) Like "*" & Str & "*" Then I = I + 1 '利用like语句判断字符串位于其中的次数
附示例文件。
 数据的统计.rar
|
