Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10566 / 13644 ツリー ←次へ | 前へ→

【21060】個別成績表を一気に作成するには・・・。 みん 05/1/9(日) 13:35 質問[未読]
【21061】Re:個別成績表を一気に作成するには・・... ponpon 05/1/9(日) 14:21 回答[未読]
【21064】Re:個別成績表を一気に作成するには・・... みん 05/1/9(日) 15:34 お礼[未読]
【21071】Re:個別成績表を一気に作成するには・・... ponpon 05/1/9(日) 23:00 質問[未読]
【21074】Re:個別成績表を一気に作成するには・・... ponpon 05/1/10(月) 16:41 回答[未読]

【21060】個別成績表を一気に作成するには・・・。
質問  みん  - 05/1/9(日) 13:35 -

引用なし
パスワード
   はじめまして。

No  氏名  国語  算数  理科  合計  平均  順位
1  はなこ  89   90   78   257  85.5   1
2  ようこ  56   61   78   195  65.0   3  
3  ひとみ  78   89   69   236  78.6   2

  平均点  74.3  80   75   229.3
  最高点   **  **   **    **
  最低点   **  **   **    **

上のような表から偏差値や学年順位を含めた
個人成績表を生徒番号(No)を入力するだけでレーダーチャートグラフ
まで作成できるものをVLOOKUP関数を使って作っています。

          番号 1 氏名 はなこ  総合順位

       国語   算数   理科   合計
得点     **    **     **   **
学年平均   **    **     **   ** 
偏差値    **    **     **   **
学年順位   **    **     **   **


          レーダーチャートグラフ


一人分のデータを出すだけでしたら充分なのですが
何人ものデータの処理を一度に作成することは
マクロやVBAで可能でしょうか?

一気に作成して一気に印刷できたら・・・と思います。
よろしくお願いいたします。

【21061】Re:個別成績表を一気に作成するには・・...
回答  ponpon E-MAIL  - 05/1/9(日) 14:21 -

引用なし
パスワード
   ▼みん さん:
ponponです。こんにちは。
 回答するのは初めてです。すぐ下の質問をしている者です。
 参考になればと思って回答しました。
昨日と今日で同じようなことを考えて、作っているところです。
データが下のようにA2から入っていることを前提として、

>
>No  氏名  国語  算数  理科  合計  平均  順位
>1  はなこ  89   90   78   257  85.5   1
>2  ようこ  56   61   78   195  65.0   3  
>3  ひとみ  78   89   69   236  78.6   2
>
以下のコードを実行すると、
一覧表の横のスペースに全員のレーダーチャートが表示されます。
教科は、国語、算数、理科の3教科でよいのですね?
3角形のレーダーチャートになります。
新しいシートに一人ずつ出力するするのは、まだ勉強不足でできていません。
また、得点や学年平均、偏差値についてはレーダーチャートを作るときに、ループさせるので、そのときにセルを指定し、offsetさせて、新しく作ったsheetにセルを指定し表示させてやればよいと思います。

以下コードです。標準モジュールにコピペして、使用してください。
シートをアクティブにして実行してください。
グラフのできる位置や、色は自分で変えてください。

Sub test()
 Dim i As Integer
 Dim t As Integer
 Dim m As Long


 m = Range("A65536").End(xlUp).Row
 
 For i = 2 To m
 t = ((i - 2) \ 4) * 200
 
  With ActiveSheet.ChartObjects.Add(Left:=500 + ((i - 2) Mod 4) *  _
   200, Top:=t + 9, Width:=200, Height:=200).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 = 33
    .Top = 40
    .Width = 130
    .Height = 130
   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

 Next


End Sub

'************************************************************************
Sub グラフの削除()
  Dim CH As ChartObject
  ActiveSheet.Unprotect
  
  Set allCH = ActiveSheet.ChartObjects
 For Each CH In allCH
    CH.Delete
 Next


End Sub

【21064】Re:個別成績表を一気に作成するには・・...
お礼  みん  - 05/1/9(日) 15:34 -

引用なし
パスワード
   ▼ponpon さん:

ponponさん、こんにちは。

ありがとうございます!!
VBAは、自分で作ったことがなく、
今回、辞典や本を買ってできるかどうか調べていたのですが
難しすぎてお手上げ状態でした。

ponponさんのコードを実行してみて
感動しているくらいの初心者です。

>また、得点や学年平均、偏差値についてはレーダーチャートを作るときに、ループさせるので、そのときにセルを指定し、offsetさせて、新しく作ったsheetにセルを指定し表示させてやればよいと思います。

恥ずかしながら、おっしゃっている意味が分からないのですが
今から、調べながら操作してみたいと思っています。

>グラフのできる位置や、色は自分で変えてください。

はい。
ありがとうございます。

全然見当もつかなかったのですが
先が見えてきて、とてもうれしいです。
感謝しています。
取り急ぎ、お礼まで。

【21071】Re:個別成績表を一気に作成するには・・...
質問  ponpon E-MAIL  - 05/1/9(日) 23:00 -

引用なし
パスワード
   ▼みん さん:
 こんばんは。
夜帰ってみてびっくりです。お礼がはいっているではありませんか。
私のような初心者の回答に!!!!!

>ありがとうございます!!
>VBAは、自分で作ったことがなく、
>今回、辞典や本を買ってできるかどうか調べていたのですが
>難しすぎてお手上げ状態でした。
 私も、本とここの掲示板をたよりにいろんな物を作って楽しんでいるところです。

>ponponさんのコードを実行してみて
>感動しているくらいの初心者です。

こんなべたなコードに感動しくれるなんてとてもうれしいです。
同じシートでよければ、B5ぐらいにグラフの位置を広げれば、一枚に一つのグラフになると思います。
後は、各ページの左上のセルを規準にして、表示させたい点数や項目を配列に取り入れて
表示させればよいのではないかと思いますが、何せ実力が伴いません。
   ↑
この方法は、プリンターや一覧表の幅などに左右されるので、新しいシートにグラフを貼り付けるのが、一番よいと思います。
 もう一度、質問をして、常連さんたちのすばらしい回答を待った方がよいと思います。 
 常連の皆さん!! きちんとした回答をお願いします。

【21074】Re:個別成績表を一気に作成するには・・...
回答  ponpon E-MAIL  - 05/1/10(月) 16:41 -

引用なし
パスワード
   こんにちは。ponponです。
はじめに回答した手前、他の人からの回答がないので責任を感じています。
同じページ内でよければ、何とかできるようになりましたので試してください。
ただし、実力がない物ですから、いろいろと制約がありますので許してください。
 私の環境では、一人ずつのデータとレーダーチャートが1ページに表示されています。
  
 ◎ 前提
 ・用紙サイズ・・・B5
 ・1行目に見出があるものとする。
 ・AからHまでデータが入っているものとする。
 ・平均点・最高点・最低点などはB35からF37までにデータがあるものとする。
 ・10列めから一人ずつのデータが入りますので、
  一覧表は8または9列目までにおさめてください。
 ・縦のカラム数は、標準でお願いします。
 以上

 以下コードです。
 表示する位置や取得しているデータの場所はコメントをつけていますので、あわなけれ ば変更してください。

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

10566 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free