求一个自动统计代码，谢谢大家，初学者

2376803 · 发表于 2018-8-10 23:46

想做一个自动统计分表人员获得评价的次数的代码。具体功能要求在附件里面

数据.rar (9.25 KB, 下载次数: 9)

qingc0221 · 发表于 2018-8-11 05:28

Private Sub 统计_Click()
Dim LastRow As Long, i As Long, m As Long, n As Long
Dim d As Object
Dim Arr, Result()
Set d = CreateObject("Scripting.Dictionary")
For Each sht In Worksheets
If sht.Name <> Me.Name Then
Arr = sht.Range("A1").CurrentRegion
For i = 2 To UBound(Arr)
If d.Exists(Arr(i, 1)) = False Then
n = n + 1
d(Arr(i, 1)) = n
ReDim Preserve Result(1 To 5, 1 To n)
Result(1, n) = Arr(i, 1)
m = n
Else
m = d(Arr(i, 1))
End If
Result(Asc(Arr(i, 2)) - 63, m) = Result(Asc(Arr(i, 2)) - 63, m) + 1
Next i
End If
Next sht
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
If LastRow > 1 Then
Range(Rows(2), Rows(LastRow)).Delete
End If
Range("A2").Resize(n, 5) = Application.Transpose(Result)
Range("A1").CurrentRegion.Borders.Weight = xlThin
End Sub

复制代码

qingc0221 · 发表于 2018-8-11 05:29

........................................

xiangbaoan · 发表于 2018-8-11 07:45

Sub test()
Dim d As Object, ar, br, r&, c%, y&, x%, sht As Worksheet
Set d = CreateObject("scripting.dictionary")
[a1].CurrentRegion.Offset(1, 1) = ""
ar = [a1].CurrentRegion
For r = 2 To UBound(ar)
d(ar(r, 1)) = r
Next
For c = 2 To UBound(ar, 2)
d(ar(1, c)) = c
Next
For Each sht In Sheets
With sht
      If .Name <> "总表" Then
         br = .[a1].CurrentRegion
         For r = 2 To UBound(br)
            If d.exists(br(r, 1)) And d.exists(br(r, 2)) Then
                  y = d(br(r, 1))
                  x = d(br(r, 2))
                  ar(y, x) = ar(y, x) + 1
            End If
         Next
      End If
End With
Next
[a1].CurrentRegion = ar
Set d = Nothing
End Sub

chaohuahch · 发表于 2018-8-11 20:55

代码如下：供测试：

Sub fyExcelVBA()
Dim arr, brr, i%, j%, str$
Dim dic As Object, sht As Worksheet
Set dic = CreateObject("scripting.dictionary")
For Each sht In Worksheets
If sht.Name <> "总表" Then
arr = sht.Range("a1").CurrentRegion
For i = 2 To UBound(arr)
str = arr(i, 1) & arr(i, 2)
If Not dic.exists(str) Then
dic(str) = 1
Else
dic(str) = dic(str) + 1
End If
Next i
End If
Next
With Sheets("总表")
brr = .Range("a1").CurrentRegion
For i = 2 To UBound(brr)
For j = 2 To UBound(brr, 2)
str = brr(i, 1) & brr(1, j)
brr(i, j) = dic(str)
Next j
Next i
.Range("a1").Resize(UBound(brr), UBound(brr, 2)).ClearContents
.Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
End With
Set dic = Nothing
End Sub

复制代码

2376803 · 发表于 2018-8-11 22:10

qingc0221 发表于 2018-8-11 05:28

谢谢大神，但是有个问题，就是我的总表里面评分不是固定不变的，我需要根据总编里面评分栏的变化，来统计分表的，简单的说就是我不只有ABCD的可能还有A+ A-之类的，然后我在第一行修改A变成A+，然后就统计分变出现的A+。代码该如何修改呢，自己改了运行不来。

2376803 · 发表于 2018-8-11 22:11

qingc0221 发表于 2018-8-11 05:28

谢谢大神，但是有个问题，就是我的总表里面评分不是固定不变的，我需要根据总编里面评分栏的变化，来统计分表的，简单的说就是我不只有ABCD的可能还有A+ A-之类的，然后我在第一行修改A变成A+，然后就统计分变出现的A+。代码该如何修改呢，自己改了运行不来。

2376803 · 发表于 2018-8-11 22:12

谢谢大神，但是有个问题，就是我的总表里面评分不是固定不变的，我需要根据总编里面评分栏的变化，来统计分表的，简单的说就是我不只有ABCD的可能还有A+ A-之类的，然后我在第一行修改A变成A+，然后就统计分变出现的A+。代码该如何修改呢，自己改了运行不来。

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

[求助] 求一个自动统计代码，谢谢大家，初学者