利用vba多条件统计个数

香山红叶7326 · 发表于 2024-12-13 18:04

因工作需要，不停地统计人数，比较麻烦，想通过vba一劳永逸，请各位大神帮忙，不胜感激

dambcer · 发表于 2024-12-13 18:34

透视表一劳永逸

3190496160 · 发表于 2024-12-14 17:39

Sub 分类统计()
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("数据")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "数据表为空！": End
ar = .Range("a1:f" & r)
End With
With Sheets("汇总")
.UsedRange.Offset(3) = Empty
br = .Range("a2:t" & r)
For j = 2 To UBound(ar, 2) Step 2
      If br(1, j) <> "" Then
         dc(br(1, j)) = j
      End If
Next j
k = 2
For i = 2 To UBound(ar)
      If ar(i, 1) <> "" Then
         t = d(ar(i, 1))
         If t = "" Then
            k = k + 1
            d(ar(i, 1)) = k
            t = k
            br(k, 1) = ar(i, 1)
         End If
         If ar(i, 4) <> "" Then
            If IsNumeric(ar(i, 4)) Then
                  lh = dc(ar(i, 4))
                  If lh <> "" Then
                     If ar(i, 5) = "应届" Then
                        br(t, lh) = br(t, lh) + 1
                        br(t, 18) = br(t, 18) + 1
                     Else
                        br(t, lh + 1) = br(t, lh) + 1
                        br(t, 19) = br(t, 19) + 1
                     End If
                     br(t, 20) = br(t, 20) + 1
                  End If
            End If
         End If
      End If
Next i
.[a2].Resize(k, UBound(br, 2)) = br
End With
End Sub

3190496160 · 发表于 2024-12-14 17:41

测试.rar (25.24 KB, 下载次数: 1)

		自动登录	找回密码
密码			免费注册