| |
こんにちは。ponponです。
はじめに回答した手前、他の人からの回答がないので責任を感じています。
同じページ内でよければ、何とかできるようになりましたので試してください。
ただし、実力がない物ですから、いろいろと制約がありますので許してください。
私の環境では、一人ずつのデータとレーダーチャートが１ページに表示されています。
◎ 前提
・用紙サイズ・・・B5
・１行目に見出があるものとする。
・AからHまでデータが入っているものとする。
・平均点・最高点・最低点などはB35からF37までにデータがあるものとする。
・１０列めから一人ずつのデータが入りますので、
一覧表は８または９列目までにおさめてください。
・縦のカラム数は、標準でお願いします。
以上
以下コードです。
表示する位置や取得しているデータの場所はコメントをつけていますので、あわなけれ ば変更してください。
Sub test()
Dim i As Integer
Dim t As Integer
Dim m As Long
m = Range("A65536").End(xlUp).Row
j = 0
For i = 2 To m
t = ((i - 2) \ 4) * 635 ’←グラフのトップ位置
’↓左端からグラフの位置
With ActiveSheet.ChartObjects.Add(Left:=470 + ((i - 2) Mod 4) * 380, _ Top:=t + 200, Width:=250, Height:=250).Chart
.SetSourceData Source:=Union(Range(Cells(1, 2), Cells(1, 5)), _
Range(Cells(i, 2), Cells(i, 5))), PlotBy:=xlRows
.ChartType = xlRadarFilled
.SeriesCollection(1).Interior.ColorIndex = 4 ’←塗りつぶしの色
.HasLegend = False ’←凡例は表示しない
With .PlotArea
.Interior.ColorIndex = 36 ’←背景の色
.Left = 45 ’レーダーのサイズ・位置
.Top = 60 ’レーダーのサイズ・位置
.Width = 150 ’レーダーのサイズ・位置
.Height = 150 ’レーダーのサイズ・位置
End With
With .Axes(xlValue)
.MajorGridlines.Border.ColorIndex = 3 'ラインの色
.MinimumScale = 0 ’最低目盛
.MaximumScale = 100 ’最高目盛
.MinorUnit = 5
.MajorUnit = 20 ’目盛間隔
.Crosses = xlAutomatic
.ScaleType = xlLinear
.DisplayUnit = xlNone
.TickLabels.NumberFormatLocal = "0_ " ’目盛の表示は整数
End With
End With
With ActiveSheet '表題の表示
.Cells(((i - 2) \ 4) * 47 + 2, j * 7 + 10).Resize(, 7).Value _
= Range("B1:H1").Value
'データの表示
.Cells(((i - 2) \ 4) * 47 + 3, j * 7 + 10).Resize(, 7).Value _
= Range(Cells(i, 2), Cells(i, 8)).Value
'平均点最高最低の表示
.Cells(((i - 2) \ 4) * 47 + 5, j * 7 + 10).Resize(3, 5).Value _
= Range("B35:F37").Value
End With
j = j + 1
If j > 3 Then j = 0
Next i
End Sub
Sub グラフの削除()
Dim CH As ChartObject
ActiveSheet.Unprotect
Set allCH = ActiveSheet.ChartObjects
For Each CH In allCH
CH.Delete
Next
m = Range("A65536").End(xlUp).Row
j = 0
For i = 2 To m
With ActiveSheet '各種データの削除
.Cells(((i - 2) \ 4) * 47 + 2, j * 7 + 10).Resize(, 7).Value = ""
.Cells(((i - 2) \ 4) * 47 + 3, j * 7 + 10).Resize(, 7).Value = ""
.Cells(((i - 2) \ 4) * 47 + 5, j * 7 + 10).Resize(3, 5).Value = ""
End With
j = j + 1
If j > 3 Then j = 0
Next
End Sub
|
|
ponpon
- 05/1/10(月) 16:41 -
