|
|
| Excel VBA Macro ・ コピー ・ FAQ |
|
氏名一覧表からクラス別表を作成するには？
|
|
|
|
Question 82.3 |
Excel VBA Borad （掲示板）より |
 |
 |
|
|
まったくの初心者なので、事例を調べてみれば見るほどパニックになっています。 どなたか、下記の処理について教えて頂けないでしょうか。
Ａ 書式の決まったシート（クラス表）があります。（1クラスごとでそれに所属する人員名は6件しか入力できません。）
Ｂ クラス名と所属する人員名の一覧表があります。（クラス名の数と人員名の数は月ごとに変動します。）
Ａのクラス表を必要枚数コピーして、クラス表Ｍ(1)(2)(3)…を作成し、
Ｂの一覧表から各クラスごと6名づつ データを書き出したいのですが、どのようにしたらいいでしょうか？
【補足】 ・一覧表は重複を取り除いた、クラス名とそれに対応する氏名の一覧です。
・1クラスが6名以上とか12名を超える場合もあります。
・人数は月ごとに変動し不特定です。
シートをコピーするとシート名が(1)(2)(3)・・・と変動しますし、どのようにしたらいいでしょうか？
ややこやしくて申し訳ありませんが、よろしくお願いします 。
|
|
Answer |
Copyright (C) 2007.6.14 永井善王 |
|
|
【概念図・第1ステップ】
プログラミングの練習要素をたくさん含んだテーマですね。
本格的にフローチャートを描いて、プロ的に組みたくなりがちですが、ムリしないで、Excelらしく処理することをお勧めします。
具体的には、いっぺんに処理するとゴチャゴチャになり易いので、段階的に区切って処理します。
（データが何十万件とか膨大ならば話は別です。）
1. 6行区切りに編集した一時シートを作成する
左の【概念図・第1ステップ】のように、
一覧表シートのクラス名の変わり目で区切りながら、1クラスが6の倍数行になるように一時シートを作成します。
人数が不足する場合は空行とします。
2. 一時シートからクラス表Mを作成する(※)
クラス表シート
一時シートの人員名を上から6行コピーして、
クラス表シートの人員名(B2セル)に貼り付けます。
その後、クラス表シートのコピーを作成し、クラス表Mとしてのシート名を設定します。
(※)マクロの中では「クラス別表」と表記してます。
続いて、この処理をクラス表シートの下方向へ繰り返します。 そして、全クラス分の処理ができたら、一時シートを削除してから終わります。 以下にマクロをお示しします。 コードの各行のコメントを読んで理解を深めてください。
Option Explicit
Dim 一時シート, 下端行, 貼付行, 取出行, 余白行, シート番号
'-----------------------------------------------------------------------------------------
Sub 氏名一覧表からクラス別表を作成する()
一覧表から同クラス分を取り出して一時シートを作成する
一時シートから6行ずつコピーしてクラス別表を作成する
一時シートを削除する
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 一覧表から同クラス分を取り出して一時シートを作成する()
Application.ScreenUpdating = False '画面を更新しない
Sheets.Add '新シートを挿入(一時シート)
一時シート = ActiveSheet.Name '新シートの名前を取得
下端行 = Worksheets("一覧表").Range("A" & Rows.Count).End(xlUp).Row 'データ下端行取得
貼付行 = 0 '貼付行カウンタをリセット
For 取出行 = 2 To 下端行
If 取出行 <> 2 Then '1番最初の取り出しでなければ
If Worksheets(一時シート).Range("A" & 貼付行) _
<> Worksheets("一覧表").Range("A" & 取出行) Then 'クラス名(さっき:今)
余白行 = 6 - 貼付行 Mod 6 '6行単位するための余白行数を算出
貼付行 = 貼付行 + 余白行 '貼付行カウンタを余白行数分アップ
End If
End If
貼付行 = 貼付行 + 1 '貼付行カウンタを1アップ
Worksheets("一覧表").Rows(取出行).Copy Destination:= _
Worksheets(一時シート).Range("A" & 貼付行) '一覧表から一時シートへ1行コピー
Next
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 一時シートから6行ずつコピーしてクラス別表を作成する()
下端行 = Worksheets(一時シート).Range("A" & Rows.Count).End(xlUp).Row
For 取出行 = 1 To 下端行 Step 6
If Worksheets(一時シート).Range("A" & 取出行) = "" Then Exit For 'データなければ
Worksheets("クラス表").Range("B2:C7").ClearContents 'クリア
Worksheets(一時シート).Range("B" & 取出行 & ":" & "B" & 取出行 + 5).Copy '6行
Worksheets("クラス表").Range("B2").PasteSpecial Paste:=xlValues '値を貼り付け
Worksheets("クラス表").Copy Before:=Worksheets("クラス表") '新シート作成
シート番号 = シート番号 + 1 'シート番号を繰り上げ
ActiveSheet.Name = "クラス表M(" & シート番号 & ")" '新シートの名前を設定
Next
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 一時シートを削除する()
Application.DisplayAlerts = False '警告メッセージを表示しない
Worksheets(一時シート).Delete '一時シートを削除
Application.ScreenUpdating = True '画面を更新する
End Sub
'-----------------------------------------------------------------------------------------
仕事の時間がきてしまったので、これで解説を終わりにしますが、サンプルブックにはプロ的に組んだマクロも入れてあります。 書き下ろしですが、探究心の素材くらいにはなるかなと思っています。
サンプルブックのダウンロードは ここをクリック
（YNxv99113_Copy.xls 122KB）
※ 一旦、ブックをハードディスクに保存し、後で改めて開いてから実行してください。
|
|
|
|
|
