估计时间也差不多了,现献丑公布我的答案:
Dim arr, counts() As Integer, arr2(1 To 500, 0) Dim maximum&, minimum&, temp& Dim i&, j&, k&, p&, t1 maximum = Application.Max(Range(Cells(1, 1), Cells(65536, 4))) minimum = Application.Min(Range(Cells(1, 1), Cells(65536, 4))) arr = Range(Cells(1, 1), Cells(65536, 4)) ReDim counts(minimum To maximum) As Integer temp = arr(1, 1) For j = 1 To 4 For i = 1 To 65536 If arr(i, j) <> temp Then counts(temp) = counts(temp) + 1 temp = arr(i, j) Next i Next j counts(temp) = counts(temp) + 1 i = 1 For p = maximum To minimum Step -1 If counts(p) <> 0 Then arr2(i, 0) = p & "\" & counts(p) If i = 500 Then Exit For i = i + 1 End If Next p Range(Cells(1, 7), Cells(500, 7)) = arr2
LGDgako5.rar
(9.72 KB, 下载次数: 115)
总结评述就以19楼的为准,暂时没有新的内容了。期望版主为该贴评分。
|