出産前後の痔にはご注意!

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

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

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

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

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

1列目はタイトル、2列目から入力された必要数値となります。
A列には日付(A2セルから1日→A32セル=31日まで)
B列には体温(B2から数値記載)
C列には体重(C2から数値記載)
D列には体脂肪率(D2から数値記載)
E列にはBMI(E2から数値記載)
F列には血圧(F2から数値記載)

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

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

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

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

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

以上

このQ&Aに関連する最新のQ&A

A 回答 (5件)

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



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

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

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

'---------------------------------------------
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
●"日付"● の部分を変更すること。 
 
 

この回答への補足

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

コピー先の条件は一切変わらぬものとして、
A列:日付~F列:血圧の6列分の測定結果が、8列、9列と引用する列が増加した場合と
A列~F列がR列~Z列などに範囲が変わった際にはどの様に対応したら宜しいのでしょうか?

補足日時:2009/05/01 10:46
    • good
    • 0

半分以後になって「(2) マクロ実行」が現れて、初めてVBAの質問らしいと判る。


こんな書き方はまずい。標題に「VBAで・・」を入れるべきだ。

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

====
シート名を指定されたとき(まずはInputBoxで聞く、初歩的な方法でやる)シートを探すのは
Sub test02()
sn = InputBox("シート名=")
Set sh = Worksheets(sn)
For i = 1 To 3 '3行の例
For j = 1 To 3 'A,B,Cの3列の例
MsgBox sh.Cells(i, j)
Next j
Next i
End Sub
で良い。
上記のSet sh = Worksheets(sn)やsh.Cells(i, j)のようなやり方は簡単そうだが、独学では、なかなか到達しないだろう。
Sheet1で
A1:C3 文字列にしているが「数値でも同じ。
a1b1c1
a2b2c2
a3b3c3
とするとa1,B1,c1,A2,B2,C2,A3,B3,C3の順にセルの値が表示されるだろう。
最下行は第31+アルファ(一定数)行に決まっているなら
For i = 1 To 35などのようになる。人ごとに同じ行数かどうかはっきり書いてないが重要。
ーー
集計シートに集約するのは、前までに集約してなった行番号を変数(例えばk)に記憶し、1名分集約し終わったたら行数分加える。
次はその次行からデータを集める。
コピーは避けて
集計シートのセル=各人シートのセル
をお勧めする。とりあえずうまく行ったら、
各人シートのセル群コピーーー>集計シートの貼り付け左上セル指定し貼り付け(Destinationの記述)をやると良い。
ーー
集計シートのセルの指定は
or i=3 to 35
Worksheets("集計シート").Cells(k,j)=Worksheets("Aさん").Cells(i,j) 集計シートの列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" になる。
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/05/01 10:10

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



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

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
    • good
    • 0

>コードの意味が理解できず、近づくことすら出来ません。


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

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
    • good
    • 0

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

この回答への補足

お世話になります。

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

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

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

補足日時:2009/04/28 17:56
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング