第1个回答 2010-07-07
Sub Macro1()
Dim ARow As Integer
Sheets("sheet1").Select
Columns("C:C").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
ARow = ActiveCell.Row - 1
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R" & ARow & "C3").CreatePivotTable TableDestination:="", TableName:= _
"数据透视表1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(1, 1)
ActiveSheet.Cells(1, 1).Select
ActiveSheet.PivotTables("数据透视表1").AddFields RowFields:="考试类型"
With ActiveSheet.PivotTables("数据透视表1").PivotFields("分数")
.Orientation = xlDataField
.Caption = "最大值项:分数"
.Position = 1
.Function = xlMax
End With
With ActiveSheet.PivotTables("数据透视表1").PivotFields("分数")
.Orientation = xlDataField
.Caption = "最小值项:分数"
.Position = 2
.Function = xlMin
End With
With ActiveSheet.PivotTables("数据透视表1").PivotFields("分数")
.Orientation = xlDataField
.Caption = "平均值项:分数"
.Position = 3
.Function = xlAverage
End With
With ActiveSheet.PivotTables("数据透视表1").PivotFields("分数")
.Orientation = xlDataField
.Caption = "方差项:分数"
.Function = xlVar
End With
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Name = "统计"
Dim CountX(4, 2) As Single
For i = 1 To 4
CountX(i, 1) = Cells(2 + (i - 1) * 4, 3)
CountX(i, 2) = Cells(3 + (i - 1) * 4, 3)
Next i
Dim MAXMIN(4, 2) As Single
Sheets("sheet1").Select
For j = 2 To ARow
Select Case Cells(j, 2).Text
Case "A"
If Cells(j, 3).Value = CountX(1, 1) Then
MAXMIN(1, 1) = MAXMIN(1, 1) + 1
ElseIf Cells(j, 3).Value = CountX(1, 2) Then
MAXMIN(1, 2) = MAXMIN(1, 2) + 1
End If
Case "B"
If Cells(j, 3).Value = CountX(2, 1) Then
MAXMIN(2, 1) = MAXMIN(2, 1) + 1
ElseIf Cells(j, 3).Value = CountX(2, 2) Then
MAXMIN(2, 2) = MAXMIN(2, 2) + 1
End If
Case "C"
If Cells(j, 3).Value = CountX(3, 1) Then
MAXMIN(3, 1) = MAXMIN(3, 1) + 1
ElseIf Cells(j, 3).Value = CountX(3, 2) Then
MAXMIN(3, 2) = MAXMIN(3, 2) + 1
End If
Case "D"
If Cells(j, 3).Value = CountX(4, 1) Then
MAXMIN(4, 1) = MAXMIN(4, 1) + 1
ElseIf Cells(j, 3).Value = CountX(4, 2) Then
MAXMIN(4, 2) = MAXMIN(4, 2) + 1
End If
End Select
Next j
Sheets("统计").Select
For i = 1 To 4
Cells(2 + (i - 1) * 4, 4) = MAXMIN(i, 1)
Cells(3 + (i - 1) * 4, 4) = MAXMIN(i, 2)
Next i
Range("D1").Value = "最大最小值数"
End Sub