如何统计缺考人数

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, S$, IIF2$, Arr As Variant, i%
    Set Cn = CreateObject("Adodb.Connection")
    S$ = "IIF(语文 Is Null,'语文',Null) As 语文,IIF(数学 Is Null,'数学',Null) As 数学,IIF(英语 Is Null,'英语',Null) As 英语," _
        & "IIF(政治 Is Null,'政治',Null) As 政治,IIF(历史 Is Null,'历史',Null) As 历史,IIF(地理 Is Null,'地理',Null) As 地理," _
        & "IIF(物理 Is Null,'物理',Null) As 物理,IIF(化学 Is Null,'化学',Null) As 化学,IIF(生物 Is Null,'生物',Null) As 生物"
    IIF1 = "IIF(组合='物化生',物理 Is Null Or 化学 Is Null Or 生物 Is Null,IIF(组合='物化地',地理 Is Null Or 物理 Is Null Or 化学 Is Null," _
        & "IIF(组合='政史地',政治 Is Null Or 历史 Is Null Or 地理 Is Null,政治 Is Null Or 历史 Is Null Or 生物 Is Null))))"
    IIF2 = "IIF(组合='物化生',物理&' '&化学&' '&生物,IIF(组合='物化地',地理&' '&物理&' '&化学," _
        & "IIF(组合='政史地',政治&' '&历史&' '&地理,政治&' '&历史&' '&生物)))"
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    StrSQL = "Select 班级,考号,姓名," & S & ",组合 From [Sheet1$A:M] Where 语文 Is Null Or 数学 Is Null Or 英语 Is Null Or(" & IIF1
    StrSQL = "Select 班级,考号,姓名,语文&' '&数学&' '&英语&' '&" & IIF2 & " From (" & StrSQL & ") "
    Arr = Cn.Execute(StrSQL).GetRows
    For i = 0 To UBound(Arr, 2)
        Arr(3, i) = Replace(Application.Trim(Arr(3, i)), " ", "，")
    Next i
    Range("O17").Resize(i, 4) = Application.Transpose(Arr)
End Sub

飞天篮球猪

可4线程并行执行

ykcbf1100

参与一下，字典

ykcbf1100

缺考统计，字典

1. Sub ykcbf()   '//2024.7.18   缺考统计
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     r = Cells(Rows.Count, 1).End(3).Row
   
6.     arr = [a1].Resize(r, 13)
   
7.     ReDim brr(1 To r, 1 To 4)
   
8.     For j = 4 To 12
   
9.         s = Left(arr(1, j), 1)
   
10.         d1(s) = j
    
11.     Next
    
12.     For i = 2 To UBound(arr)
    
13.         st = Replace(arr(i, 13), "史", "历")
    
14.         st = "语数英" & st
    
15.         s = arr(i, 2)
    
16.         For x = 1 To Len(st)
    
17.             j = d1(Mid(st, x, 1))
    
18.             If Val(arr(i, j)) = 0 Then
    
19.                 If Not d.exists(s) Then
    
20.                     m = m + 1
    
21.                     d(s) = m
    
22.                     brr(m, 1) = arr(i, 1)
    
23.                     brr(m, 2) = arr(i, 2)
    
24.                     brr(m, 3) = arr(i, 3)
    
25.                     brr(m, 4) = arr(1, j)
    
26.                 Else
    
27.                     r = d(s)
    
28.                     brr(r, 4) = brr(r, 4) & "，" & arr(1, j)
    
29.                 End If
    
30.             End If
    
31.         Next
    
32.     Next
    
33.     [o2:r1000] = ""
    
34.     [o2].Resize(m, 4) = brr
    
35.     Application.ScreenUpdating = True
    
36.     MsgBox "OK！"
    
37. End Sub
    

复制代码

戎马书生222

感谢论坛好友的思路。正在努力学习。谢谢

一招秒杀

1句4行，只用到1个字符拼接函数 String_Agg, 没有变量，没有循环。更没有循环套循环，完美解决。

戎马书生222

一招秒杀 发表于 2024-7-18 21:55
1句4行，只用到1个字符拼接函数 String_Agg, 没有变量，没有循环。更没有循环套循环，完美解决。

强。这是什么东东？不知道怎么学