48、又一个关于不重复值的计算及统计个数。代码来自UNARTHUR兄,相当经典,建议学习数组的朋友仔细阅读。原问题在http://club.excelhome.net/viewthread.php?tid=125028
yPB0bYic.rar
(12.89 KB, 下载次数: 228)
代码:
Private Sub CommandButton1_Click() '一次循环,得到多组数据,数组使用的经典
Dim i&, n&, m1&, m2&, iMax%
Dim arr, arr1, arr2, arr3()
Application.ScreenUpdating = False
p = [a65536].End(xlUp).Row
Set rng = Range(Cells(2, 1), Cells(p, 3)) '整个区域设置为一个变量rng,方便引用
arr = rng '用arr记录这个原始的数据,方便在排序之后,重新设置回原先值
rng.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Header:=xlGuess
arr1 = rng '按C列和A列排序
rng.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlGuess
arr2 = rng '按C列和B列排序
iMax = UBound(arr) '数组的最大值
ReDim arr3(1 To iMax, 1 To 3) '定义了一个范围很大的数组,作为最终要求的数组
n = 1: m1 = 1: m2 = 1 '设置初始值
For i = 2 To iMax
If arr1(i, 3) <> arr1(i - 1, 3) Then '假如c列不相等的时候,这时记录下一组值,如下分析
arr3(n, 1) = arr1(i - 1, 3)
arr3(n, 2) = m1 '记录A列不重复次数
arr3(n, 3) = m2 '记录B列不重复次数
n = n + 1: m1 = 1: m2 = 1 '记录之后重新设置为初始值
Else
If arr1(i, 1) <> arr1(i - 1, 1) Then m1 = m1 + 1 '不相等就增加m1、m2
If arr2(i, 2) <> arr2(i - 1, 2) Then m2 = m2 + 1
End If
Next i
arr3(n, 1) = arr1(iMax, 3): arr3(n, 2) = m1: arr3(n, 3) = m2 '对于最后一组数单独记录
Range("e2:g" & p) = arr3 '给单元格赋值
rng = arr '把原先排序打乱顺序的重新赋回原先的值
Application.ScreenUpdating = True
End Sub
【UNARTHUR兄,对不起了,今天下午实在太忙,把你的代码改来改去的。现在应该OK了,请查看】
对于数组的用法,必须得知道的知识,UNARTHUR兄的“[原创][数组]补充一些大家不太了解的数组用法”http://club.excelhome.net/viewthread.php?tid=127324
[此贴子已经被作者于2005-10-13 10:39:14编辑过] |