| |
▼おおば さん：
こんにちは
コード案です。
合計行は１つのみ設定可能ですから平均点と件数はリスト外（リストから２行あけた１の行）に表示します。
留意点があります。できあがったリストはListObjectですから行の追加が可能です。
追加の行の合計列には自動的に計算式が入りますし、平均点、件数も、追加を反映します。
ただし、リストが下に拡大して下いくわけですので、この平均点、件数の行の上にかぶさってしまいます。
なので、たとえば行を３行追加するということであれば、追加前に、リストと平均点の行の間に、
３行程度の行をインサートしておいてください。
Sub Sample()
Dim fCol As Long, tCol As Long
Dim zCol As Long
Dim fRow As Long, tRow As Long
Dim zRow As Long
Dim sht As Worksheet
Set sht = Workbooks("学力試験.xls").Worksheets("試験結果")
sht.Activate
If ActiveSheet.ListObjects.Count = 0 Then
ActiveSheet.ListObjects.Add SourceType:=xlSrcRange, Source:=Range("B7").CurrentRegion
End If
With ActiveSheet.ListObjects(1)
fCol = .ListColumns("国語").Range.Column
tCol = .ListColumns("理科").Range.Column
zCol = .ListColumns("合計点").Range.Column
fRow = .Range.Row + 1
tRow = .Range.Row + .Range.Rows.Count - 2
zRow = tRow + 4
'------合計列の計算式セット---------
With .ListColumns("合計点").Range
.Cells.Offset(1).Resize(.Cells.Count - 2).FormulaR1C1 = _
"=SUM(RC" & fCol & ":RC" & tCol & ")"
End With
.Range.Sort key1:=Range("I8"), order1:=xlDescending '降順
.ShowTotals = True
'------合計点を記入する---------
.ListColumns("国語").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("英語").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("社会").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("数学").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("理科").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("合計点").TotalsCalculation = xlTotalsCalculationSum
End With
'------平均点を記入する---------
Cells(zRow, 1).Value = "平均点"
Cells(zRow, fCol).Resize(, zCol - fCol + 1).FormulaR1C1 = _
"=AVERAGE(R" & fRow & "C:R" & tRow & "C)"
'------数値データーの数を記入する---------
Cells(zRow + 1, 1).Value = "件数"
Cells(zRow + 1, fCol).Resize(, zCol - fCol + 1).FormulaR1C1 = _
"=COUNT(R" & fRow & "C:R" & tRow & "C)"
Set sht = Nothing
End Sub
|
|
UO3
- 11/12/12(月) 11:24 -
