求高人帮助，多列数据双条件分类计数

乐乐2006201505

Sub test()
  Dim r%, i%, m%, n1%, n2%, n3%
  Dim d As Object
  Dim arr, brr
  Set d = CreateObject("scripting.dictionary")
  arr = Worksheets("Sheet1").Range("a1").CurrentRegion
  brr = Worksheets("Sheet2").Range("a1").CurrentRegion
  xk = Array("生物", "历史", "地理", "政治", "语文A卷", "语文B卷", "数学A卷", "数学B卷", "英语A卷", "英语B卷", "总分")
  m = 2
  For i = 0 To UBound(xk)
    For j = 1 To 8
      m = m + 1
      d(xk(i) & j) = m
    Next
  Next
  For n1 = 4 To 14
    For n2 = 2 To UBound(arr)
      If d.exists(arr(1, n1) & arr(n2, 3)) Then
        n3 = d(arr(1, n1) & arr(n2, 3))
        Select Case arr(n2, n1)
          Case "A"
            r = 3
          Case "B"
            r = 4
          Case "C"
            r = 5
          Case "D"
            r = 6
          Case "E"
            r = 7
        End Select
      End If
      brr(n3, r) = brr(n3, r) + 1
    Next
  Next
  Worksheets("Sheet2").Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

grf1973

上个JSA版的，比VBA要简洁一点。

zzzxxxmmm

谢谢各位哥哥姐姐了，我也学习了。

明天会更好zj

哈哈

第一步用代码，转化成一维表，再用透视表，轻轻松松

grf1973

VBA版本。。。。

明天会更好zj

哈哈

透视表的效果