複数シートの対象範囲セルを１つのシートに集約

質問

共通の条件で作成された複数シートの対象範囲セルを１つのシートに集約したく望んでおります。

月毎の身体測定結果を集約することが目的で、不特定の人数、名前の情報を管理しております。
（人数の最大は１０名程度）

既存ブック（測定結果.xls）を予め設け、内部に「表紙」と「集計」シートを作成。
提出されたファイル内の各シートは測定結果.xls内に全て格納。（シート名は全て氏名です）
「表紙」シートに氏名の入力欄を設定（D列2行目から下方へそれぞれ入力）
入力された氏名からブック内のシートを検索し、対象となるシートの指定セルを「集計」シートの指定セルへコピー

説明が解り辛いと思いますので、例を伴ってご説明致します。

当月の身体測定結果をＡさん・Ｂさん・Ｃさん・Ｄさん・Ｅさんの５名が提出したとします。
※各人の測定結果はそれぞれのシート名「Ａさん」、「Ｂさん」、「Ｃさん」、「Ｄさん」、「Ｅさん」で構成され、シート内の記載配列等も全て同様としております。（共通する書式フォーマットで作成）
これらのシートは全て測定結果.xls内に存在するものとします。

１列目はタイトル、２列目から入力された必要数値となります。
Ａ列には日付（A2セルから1日→A32セル=31日まで）
Ｂ列には体温（B2から数値記載）
Ｃ列には体重（C2から数値記載）
Ｄ列には体脂肪率（D2から数値記載）
Ｅ列にはBMI（E2から数値記載）
Ｆ列には血圧（F2から数値記載）

※　ブック内の「集計」シートにタイトルやＡ列の日付も予め入力。

(1)　ブック内「表紙」シートの氏名入力欄に測定者名を入力
（例：D2セル=Ａさん、D3セル=Ｂさん、D4セル=Ｃさん、D5セル=Ｄさん、D6セル=Ｅさん）
(2)　マクロ実行
(3)　入力された測定者名から合致する対象シートを検索
(4)　「表紙」シートの氏名入力欄D2セルの対象であるＡさんの情報（シート内B2::F32までの範囲）を「集計」シートB2::F32へコピー
(5)　D3セルの対象であるＢさんの情報（同じくシート内B2::F32までの範囲）を「集計」シートG2::K32へコピー（コピー先を５列毎変える）
(6)　優先順位に従い、動作を繰り返して全ての情報を「集計」シートに集約

※　コピー先への優先順位は「表紙」シートの氏名入力欄上部より判定（D2→D3→D4・・・）

このような動作をマクロ化したく望んでおります。

マクロの記録や相談箱を参考に何度かチャレンジしているのですが、コードの意味が理解できず、近づくことすら出来ません。
恐れ入りますが、ご教授いただきたくお願い致します。

以上

回答No.4

myRange · ベストアンサー

>何度かチャレンジしているのですが、コードの意味が理解できず

最初は皆、そうです。
が、習得するためには粘りと根性でそれを乗り切らないと。。。

●集計シートに、予め、日付や項目を入力しておくというのは止めて
それも全てマクロに任せた方がいいでしょう。
要するに集計シートは何もない状態、ということです。
もちろんクリアーもマクロでするわけですが。。

極力初心者用のコードにしてみました。。(^^;;;

'---------------------------------------------
Sub Test()
　Dim R As Long
　Dim Clm As Integer
　Dim Namae As String

'シート”集計”をクリアー

　Sheets("集計").Cells.Clear

'各個人のデータを”集計”へコピー

　For R = 2 To Sheets("表紙").Cells(Rows.Count, "D").End(xlUp).Row
　　　Clm = (R - 2) * 6 + 1
　　　Namae = Sheets("表紙").Cells(R, "D").Value
　　　Sheets(Namae).Range("A1:F32").Copy Sheets("集計").Cells(1, Clm)
　Next R

'最初の人の”日付列”だけ残し、他の人の”日付列”は削除

　For Clm = Sheets("集計").Columns.Count To 2 Step -1
　　　If Sheets("集計").Cells(1, Clm).Value = "日付" Then
　　　　　Sheets("集計").Columns(Clm).Delete xlShiftToLeft
　　　End If
　Next Clm

End Sub
'-------------------------------------------------------

但し、各個人のシートはちゃんとあること。
集計へコピーした後、日付列を削除するときに、
項目名の"日付"を見つけて削除しますので
"日　　付"　とか間にスペースなどがあるときは
＞If Sheets("集計").Cells(1, Clm).Value = ●"日付"● Then
●"日付"● の部分を変更すること。

補足

早速、使用してみました。

コピー先の条件は一切変わらぬものとして、
Ａ列：日付～Ｆ列：血圧の６列分の測定結果が、８列、９列と引用する列が増加した場合と
Ａ列～Ｆ列がR列～Z列などに範囲が変わった際にはどの様に対応したら宜しいのでしょうか？

回答No.5

imogasi

半分以後になって「(2)　マクロ実行」が現れて、初めてVBAの質問らしいと判る。
こんな書き方はまずい。標題に「VBAで・・」を入れるべきだ。

＞「特定の」「不特定の」が好きみたいだが、わかりにくい。
質問者が言っている意味では書く必要はないと思う。
ーー
なぜ実例を挙げないのか。回答者読者は、本当は質問者のシートを見たいのだ。それが出来ないから、判りやすい質問は、シートを例示して行うものだ。
ーー
「Aさん」シーのA,B、列の見出しは？
１，２，３・・の様子は？こういうものを書くのだよ。
列数など３、４列書けばコードの本質に影響しない。
行数も同じ。
A列ーーB列ーーーーーC列ーーーーD列
１日　体温数値　　　体重数値　体脂肪率数値　　
2日　　以下上に同じ
３日
・・
ーー
集計シートは
氏名指定順に
Bさんシート内容
1日
・・　　　Bさんシートの数値
３１日
Dさんシート内容
１日
・・　　Dさんシートの数値
３１日
Aさんシート内容
１日
・・
３１日

＝＝＝＝
シート名を指定されたとき（まずはInputBoxで聞く、初歩的な方法でやる）シートを探すのは
Sub test02()
sn = InputBox("シート名=")
Set sh = Worksheets(sn)
For i = 1 To 3 '3行の例
For j = 1 To 3 'A,B,Cの３列の例
MsgBox sh.Cells(i, j)
Next j
Next i
End Sub
で良い。
上記のSet sh = Worksheets(sn)やsh.Cells(i, j)のようなやり方は簡単そうだが、独学では、なかなか到達しないだろう。
Sheet1で
A1:C3　文字列にしているが「数値でも同じ。
a1 b1 c1
a2 b2 c2
a3 b3 c3
とするとa1,B1,c1,A2,B2,C2,A3,B3,C3の順にセルの値が表示されるだろう。
最下行は第３１＋アルファ（一定数）行に決まっているなら
For i = 1 To 35などのようになる。人ごとに同じ行数かどうかはっきり書いてないが重要。
ーー
集計シートに集約するのは、前までに集約してなった行番号を変数（例えばｋ）に記憶し、１名分集約し終わったたら行数分加える。
次はその次行からデータを集める。
コピーは避けて
集計シートのセル＝各人シートのセル
をお勧めする。とりあえずうまく行ったら、
各人シートのセル群コピーーー＞集計シートの貼り付け左上セル指定し貼り付け（Destinationの記述）をやると良い。
ーー
集計シートのセルの指定は
or i=3 to 35
Worksheets("集計シート").Cells(k,j)=Worksheets("Aさん").Cells(i,ｊ） 集計シートの列jは,個人の列と、同じか一定数プラスの列でしょう
k=k+1
Next i
以上を参考に。
http://www.officepro.jp/excelvba/sheet/index1.html
の
Dim sheet1 As Worksheet
Set sheet1 = Worksheets(2)
sheet1.Range("A1").Value = "Test"
のパターンを使う。私は sheet1を短くしてSh1などと使うように（個人的に）している。
sheet1.Range("A1").Value = "Test"はsh1.Range("A1").Value = "Test" になる。

お礼

厳しいご指摘ながらも、懇切丁寧にご説明いただきましてありがとうございました。
少しずつではありますが、コードの意味を理解できるように頑張ります。
また、質問の方法や伝え方も改善するように致しますので、今後もどうぞ宜しくお願い致します。

回答No.3

fujillin

質問文からわかる範囲で、サンプルとして作成しました。

＞マクロの記録や相談箱を参考に何度かチャレンジしているのですが
チャレンジする気があるようなので、あとは適当に修正してください。
あえて、解説等は抜きにしてあります。
入力値チェックなどは、ほとんど行っていません。

Sub test()
Dim hSheet As Worksheet, sSheet As Worksheet, dSheet As Worksheet
Dim s As Worksheet, dRng As Range
Dim rw As Long, sName As String, msg As String

Set hSheet = Worksheets("表紙")
Set dSheet = Worksheets("集計")
dSheet.Range("B2").Resize(31, Columns.Count - 1).ClearContents
Set dRng = dSheet.Range("B2:F32")
msg = ""

For rw = 2 To hSheet.Cells(Rows.Count, 4).End(xlUp).Row
　sName = hSheet.Cells(rw, 4).Value

　Set sSheet = Nothing
　For Each s In Worksheets
　　If s.Name = sName Then Set sSheet = s: Exit For
　Next s
　If sSheet Is Nothing Then
　　msg = msg & sName & " --- シートなし" & vbLf
　Else
　　dRng.Value = sSheet.Range("B2:F32").Value
　　Set dRng = dRng.Offset(0, 5)
　　msg = msg & sName & " --- コピー完了" & vbLf
　End If
Next rw

MsgBox (msg)
End Sub

回答No.2

hige_082

＞コードの意味が理解できず、近づくことすら出来ません。
分らないことは、やめた方がいいよ
仕様の変更やエラーが出た場合の回避処理は
自分でやらなければいけないので
サンプルを提示しておきますが、エラー等は自分で勉強してください

Sub test()
Dim 名前 As Variant
Dim 出力シート As Worksheet
Dim 読込範囲 As String
Dim i As Integer
Dim ii As Integer
Set 出力シート = Worksheets("集計")
読込範囲 = "B2:F32"
With Worksheets("表紙")
名前 = .Range("D2", .Range("D65536").End(xlUp))
End With
For i = 1 To UBound(名前, 1)
出力シート.Cells(2, (i - 1) * 5 + 2).Resize(31, 5).Value = Worksheets(名前(i, 1)).Range(読込範囲).Value
Next i
End Sub

回答No.1

n-jun

現在まで出来ている部分を提示してみては如何でしょう。

補足

お世話になります。

＞現在まで出来ている部分を提示してみては如何でしょう。

VBAに対してあまりにも無知なため、マクロの記録以降進んでおりません。
記録で得られたコードは以下のようになりましたが、出来ることならば氏名を別表（質問本文中「表紙」シートのD列2行目から下方）より参照し、膨大な手作業を回避したく望んでおります。

素人の無謀な質問とは思いますが、月末の集計に辟易として滅入っており、ご教授いただけるととても助かります。

Sub Macro1()

Sheets("Aさん").Select
Range("B2:F32").Select
Selection.Copy
Sheets("集計").Select
Range("B2").Select
ActiveSheet.Paste

Sheets("Bさん").Select
Range("B2:F32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計").Select
Range("G2").Select
ActiveSheet.Paste

Sheets("Cさん").Select
Range("B2:F32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計").Select
Range("L2").Select
ActiveSheet.Paste

Sheets("Dさん").Select
Range("B2:F32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計").Select
Range("Q2").Select
ActiveSheet.Paste

Sheets("Eさん").Select
Range("B2:F32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計").Select
Range("V2").Select
ActiveSheet.Paste

End Sub

※別表の氏名とシート名は必ず一致させております。
何卒、宜しくお願い致します。