请教：求已排序后的双分类均值，谢谢！

lwx228

由于数据较多，为求运算速度、特意将数据进行了排序，求速度最快的代码，谢谢！
附件在2楼，谢谢！

lwx228

附件上传成功

一把小刀闯天下

lwx228 发表于 2018-7-23 22:22
附件上传成功

'理解起来挺费劲，不过速度快的还是不要不要的，哈哈哈

Option Explicit

Sub test()
  Dim i, j, a, b, m, n, cnt, arr, sum, total
  arr = Range("a2:c" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j, 1) <> arr(j + 1, 1) Then
        total = 0: cnt = 0: n = 0
        For a = i To j
          sum = 0: n = 0
          For b = a To j
            n = n + 1
            sum = sum + arr(b, 3)
            If arr(b, 2) <> arr(b + 1, 2) Then
              a = b: cnt = cnt + 1
              total = total + sum / n: Exit For
            End If
          Next
        Next
        m = m + 1
        arr(m, 1) = arr(i, 1): arr(m, 2) = cnt: arr(m, 3) = total / cnt
        i = j: Exit For
      End If
  Next j, i
  With [l2] '输出位置自己修改
    .Resize(Rows.Count - 1, UBound(arr, 2)).ClearContents
    If m > 0 Then .Resize(m, UBound(arr, 2)) = arr
  End With
End Sub

lwx228

我烧脑模仿了一个，也不错
Sub LWX()
t0 = Timer
ar = Range("a2:c" & Cells(Rows.Count, 1).End(3).Row + 1)

    m = UBound(ar): t1 = ar(1, 1): t2 = ar(1, 2): ReDim dr(m, 2)
    dr(k, 0) = t1: Z = ar(1, 3):   j2 = 1: j = 1
    For i = 1 To m
        If ar(i, 1) <> t1 Then
            t1 = ar(i, 1): dr(k, 1) = j: dr(k, 2) = zz / j
            j = 1: zz = 0: k = k + 1: dr(k, 0) = t1
        Else
            For i2 = i + 1 To m
                If ar(i2, 2) <> t2 Then
                    t2 = ar(i2, 2): zz = Z / j2 + zz
                    j = j + 1: Z = ar(i2, 3): j2 = 1
                    If ar(i2, 1) <> t1 Then i = i2 - 1: Exit For
                Else
                    Z = ar(i2, 3) + Z: j2 = j2 + 1
                End If
            Next
        End If
     Next
     
     Cells(2, "h").Resize(k, 3) = dr
     MsgBox Format(Timer - t0, "0.000s")
End Sub