分项求和 、 统计、、

yll350

在表格不动的情况下，如何将 语数外的节数统计在q列。
                                              政史的节数 统计在R列
                                                其他的统计在s列

yll350

求教 用什么命令或者。vba

企鹅先森

用sumifs函数

yll350

sumifs . 好像不能 前6列求和。

3190496160

Sub tj()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim ar As Variant, br As Variant
Dim i As Integer
With Sheets("正课")
    r = .Cells(Rows.Count, 16).End(xlUp).Row
    .Range("q3:s" & r) = Empty
    ar = .Range("p1:s" & r)
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    br = .Range("a1:n" & rs)
    For i = 3 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    For j = 1 To UBound(br, 2) Step 2
        For i = 1 To UBound(br)
            If Trim(br(i, j)) <> "" Then
                n = d(Trim(br(i, j)))
                If n <> "" Then
                    If Trim(br(1, j)) = "语文" Or Trim(br(1, j)) = "数学" Or Trim(br(1, j)) = "英语" Then
                        m = 2
                    ElseIf Trim(br(1, j)) = "政治" Or Trim(br(1, j)) = "政治" Then
                        m = 3
                    ElseIf Trim(br(1, j)) <> "语文" And Trim(br(1, j)) <> "数学" And Trim(br(1, j)) <> "英语" And Trim(br(1, j)) <> "政治" And Trim(br(1, j)) <> "政治" Then
                        m = 4
                    End If
                    ar(n, m) = ar(n, m) + br(i, j + 1)
                End If
            End If
        Next i
    Next j
    .Range("p1:s" & r) = ar
End With
MsgBox "ok!"
End Sub

3190496160

分项目统计求教.rar (19.2 KB, 下载次数: 26)

2020-12-2 15:08 上传

点击文件名下载附件

donghui2363

练习一下，请测试

1. Sub 课时统计()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. Set d1 = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. d1("语文") = "": d1("数学") = "": d1("英语") = ""
   
6. d2("政治") = "": d2("历史") = ""
   
7. ReDim brr(1 To 1000, 1 To 4)
   
8. With Sheet1
   
9.     r = .Range("a65536").End(xlUp).Row
   
10.     arr = .Range("a1:n" & r)
    
11.     j = 1
    
12.     For i = 2 To UBound(arr)
    
13.         s = arr(i, j)
    
14.         If Not d.exists(s) Then d(s) = d.Count + 1
    
15.             brr(d(s), 1) = s
    
16.             If d1.exists(arr(1, j)) Then
    
17.                 brr(d(s), 2) = brr(d(s), 2) + arr(i, j + 1)
    
18.             ElseIf d2.exists(arr(1, j)) Then
    
19.                 brr(d(s), 3) = brr(d(s), 3) + arr(i, j + 1)
    
20.             Else
    
21.                 brr(d(s), 4) = brr(d(s), 4) + arr(i, j + 1)
    
22.             End If
    
23.         
    
24.         If i = UBound(arr) Then
    
25.             i = 1
    
26.             j = j + 2
    
27.             If j > UBound(arr, 2) Then Exit For
    
28.         End If
    
29.     Next i
    
30.     .Range("p3").Resize(d.Count, 4) = brr
    
31. End With
    
32. End Sub

复制代码

笨鸟飞不高

分项目统计求教.zip (16.31 KB, 下载次数: 28)

2020-12-2 15:25 上传

点击文件名下载附件

yaofengda

Sub Test()
Dim Arr, Brr, D, i%, j%, n$
Arr = [A1].CurrentRegion
Brr = Range([S2], [P65536].End(3))
Set D = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
    For j = 2 To UBound(Arr, 2) Step 2
        n = Arr(i, j - 1)
        k = Switch(j < 8, n & "|1", j < 12, n & "|2", j < 16, n & "|3")
        D(k) = D(k) + Arr(i, j)
    Next
Next
For i = 2 To UBound(Brr)
    For j = 1 To 3
        k = Brr(i, 1) & "|" & j
        Brr(i - 1, j) = IIf(D(k) = "", 0, D(k))
    Next
Next
[Q3].Resize(i - 2, 3) = Brr
End Sub

chenyun1234

利用PQ好像可以解决，
当然VBA最神