|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 YZC51 于 2019-6-22 14:10 编辑
请参考
Sub Test_1()
Dim Rowcount%, Rowcount1%, H%, I%, J%, K%, L%, T
Dim Arr, Arr1, Brr
Dim rng As Range
Application.ScreenUpdating = False
T = Timer
Rowcount = Sheets("Data").Range("A65536").End(xlUp).Row '返回Data表中A列的数据最大行
Rowcount1 = Sheets("结果").Range("B65536").End(xlUp).Row '返回结果表中A列的数据最大行
Arr = Sheets("Data").Range("A1:A" & Rowcount)
Sheets("结果").Range("A2:G" & Rowcount1 + 1).ClearContents '清除内容
Tmp = Sheets("结果").Range("A1")
If Rowcount < 2 Or Tmp > Rowcount Then Exit Sub
If Tmp = 0 Or IsNull(Tmp) Or Tmp = "" Then
MsgBox "A1值不能为空或零"
Exit Sub
End If
K = -Int(-Rowcount / Tmp)
Debug.Print K
ReDim Brr(1 To K, 1 To 7)
n = 0
For J = 1 To UBound(Arr, 1) Step Tmp
n = n + 1
Brr(n, 1) = n
If n > K Then Exit For
ReDim Arr1(1 To Tmp, 1 To 1)
If Tmp = 1 Then
Brr(n, 2) = Arr(J, 1)
If J > 1 Then Brr(n, 7) = Arr(J, 1) - Arr(J - 1, 1)
Else
For I = 1 To Tmp
Brr(n, 2) = Arr(J, 1)
If I + J > UBound(Arr, 1) + 1 Then Exit For
Arr1(I, 1) = Arr(J + I - 1, 1)
Next I
If J + Tmp > UBound(Arr, 1) + 1 Then Exit For
Brr(n, 3) = Arr(J + Tmp - 1, 1)
Brr(n, 4) = Application.Sum(Arr1)
Brr(n, 5) = Application.Average(Arr1)
Brr(n, 6) = Application.Max(Arr1) - Application.Min(Arr1)
Brr(n, 7) = Application.StDev(Arr1)
End If
Erase Arr1 '初始化
Next J
[A2].Resize(Rowcount \ Tmp, UBound(Brr, 2)) = Brr
[H1] = Sheets("结果").Range("B65536").End(xlUp).Row - 1
Application.ScreenUpdating = True
MsgBox "OK!用时[" & (Timer - T) & "秒]"
End Sub
|
评分
-
1
查看全部评分
-
|