EXCEL的动态统计问题

[kook]

请教一个问题!

一个文件中两个sheet
sheet1:

姓名 成绩
A 优秀
B 及格
C 优秀
D 良好
E 良好

sheet2:

成绩 人数
优秀 2
及格 1
良好 2

要求sheet2里的数据是根据sheet1自动计算的,不出现空行
sheet1有变化,sheet2自动变化(比如sheet1中增加了一行"F 不及格",sheet2中自动增加一行"不及格 1"

谢谢!

[thoughter]

=COUNTIF(Sheet1!B2:B6,A2)

[kook]

好象不对啊

[thoughter]

前面最后两行没看见，刚才在修改
现修改如下：
************************************************
'在Sheet1添加以下宏：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
i = 2
'清空Sheet2!A2:B5
Worksheets("Sheet2").Range("A2:B5") = ""
'按统计结果重写Sheet2!A2:A5
If WorksheetFunction.CountIf(Worksheets("Sheet1").Range("B:B"), "优秀") > 0 Then
Worksheets("Sheet2").Cells(i, 1) = "优秀"
Worksheets("Sheet2").Cells(i, 2) = WorksheetFunction.CountIf(Worksheets("Sheet1").Range("B:B"), "优秀")
i = i + 1
End If
If WorksheetFunction.CountIf(Worksheets("Sheet1").Range("B:B"), "良好") > 0 Then
Worksheets("Sheet2").Cells(i, 1) = "良好"
Worksheets("Sheet2").Cells(i, 2) = WorksheetFunction.CountIf(Worksheets("Sheet1").Range("B:B"), "良好")
i = i + 1
End If
If WorksheetFunction.CountIf(Worksheets("Sheet1").Range("B:B"), "及格") > 0 Then
Worksheets("Sheet2").Cells(i, 1) = "及格"
Worksheets("Sheet2").Cells(i, 2) = WorksheetFunction.CountIf(Worksheets("Sheet1").Range("B:B"), "及格")
i = i + 1
End If
If WorksheetFunction.CountIf(Worksheets("Sheet1").Range("B:B"), "不及格") > 0 Then
Worksheets("Sheet2").Cells(i, 1) = "不及格"
Worksheets("Sheet2").Cells(i, 2) = WorksheetFunction.CountIf(Worksheets("Sheet1").Range("B:B"), "不及格")
i = i + 1
End If
End Sub


*********************************************************
勉强该能用吧

[ChinaOBS]

用公式统计，存在一定的缺陷性，主要表现在：统计不重复值上。
下面给出两种方法：

1、用公式统计不重复值，需要用到名称
Private Sub CommandButton1_Click()
Dim Rng As Range, i As Integer, w1 As String
On Error Resume Next
'返回区域中不重复值的列表公式
w1 = "=IF(COUNTBLANK(data)=0,INDEX(data,SMALL(IF(MATCH(data,data,0)=ROW(INDIRECT(""1:""&ROWS(data))),MATCH(data,data,0),""""),ROW(INDIRECT(""1:""&ROWS(data))))),""有空值"")"
i = Cells(65536, 2).End(xlUp).Row '最后一行
'设定成绩区域
Set Rng = Range(Cells(2, 2), Cells(i, 2))
'动态修改区域名称
ThisWorkbook.Names("data").Delete
Rng.Name = "data" '重命名成绩区域
Sheets("sheet2").Range("a2:a65536").ClearContents '删除以前的数据
Sheets("sheet2").Range("a2:a" & i).FormulaArray = w1
Sheets("sheet2").Range("b2:b" & i).FormulaArray = "=countif(data,a2:a" & i & ")"
End Sub


2、用筛选功能，不需要名称
Private Sub CommandButton2_Click()
Dim i, j As Integer
i = Cells(65536, 2).End(xlUp).Row '最后一行
'筛选出不重复值放在C列
Range("c:c").ClearContents '清空C列
Range("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("c1"), Unique:=True
'将筛选后的列表复制到Sheet2
Sheets("sheet2").Range("a2:a65536").ClearContents '清空a列
j = Range("c65536").End(xlUp).Row
Range(Cells(1, 3), Cells(j, 3)).Copy Sheets("sheet2").Range("a1")
Sheets("sheet2").Range("b2:b" & j).FormulaArray = "=countif(sheet1!b2:b" & i & ",a2:a" & j & ")"
Sheets("sheet2").Range("b1") = "人数"
End Sub

[yigepure]

Sheet2表A列取SHEET1的不重值（用公式），其它的用COUNTIF（）