エクセルの入力データーを別のシートの日付と氏名の交差点に記録していくマクロ

質問

現在別のカテゴリーで教えていただいたマクロなのですが、
Sheet1に入力されたデータをSheet2に転記するマクロに苦しんでおります。週明けには解決したいのでこのカテゴリーにも質問することにしました。
現在の状況は以下の通りです。

Sheet1
　　　A　　　B　　　C　　　D　　
１　日付　氏名　成績　区分
２　9/23　佐藤　９５　　優

ここでマクロを実行すると

Sheet2
　　　A　　　B　　　C　　　D　　 E　 　F　　G
１　　　　　　　１組　　　　　　　２組
２　　　　田中　佐藤　小林　近藤　三浦　遠藤
３　9/19　９０　
４　9/21　　　　　　　　 ８０
５　9/21　　　　９５
６　9/21　　　　　　　　　　　　９５
７　9/22　　　　　　　　　　　　　　　　　９５

となって欲しいのですが、同じ日付で続けて入力すると

Sheet2
　　　A　　　B　　　C　　　D　　 E　 　F　　G
１　　　　　　　１組　　　　　　　２組
２　　　　田中　佐藤　小林　近藤　三浦　遠藤
３　9/19　９０　
４　9/21　　　　９５　　 ８０　 ９５
５　9/21　　　　
６　9/21　　　　　　　　　　　　
７　9/22　　　　　　　　　　　　　　　　　９５

となってしまいます。
マクロは

Sub Macro001()
'まず日付を転記します
　Range("A2").Select
　Selection.Copy
　Sheets("sheet2").Select
　Range("A65536").Select
　Selection.End(xlUp).Select
　ActiveCell.Offset(1, 0).Select
　Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
　False, Transpose:=False
　Sheets("sheet1").Select
　Application.CutCopyMode = False
　Range("C3").Select

'続いて転記します
　Dim x As Long
　Dim y As Integer

　x = Application.Match(Sheets("sheet1").Range("a2"), Sheets("sheet2").Columns(1), 0)
　y = Application.Match(Sheets("sheet1").Range("b2"), Sheets("sheet2").Rows(2), 0)
　Sheets("sheet2").Cells(x, y) = Sheets("sheet1").Range("C2")

End Sub

です。
どうかよろしくお願いいたします。

回答No.1

n-jun · ベストアンサー

http://okwave.jp/qa4344600.html
補足入っていたんですね。

Sub test()
Dim r As Range
Dim col As Long

With Worksheets("Sheet2")
Set r = .Range("A" & Rows.Count).End(xlUp).Offset(1)
If r.Row < 3 Then Set r = .Range("A3")

col = Application.Match(Worksheets("Sheet1").Range("B2").Value, _
.Range(.Range("B2"), .Cells(2, Columns.Count).End(xlToLeft)), 0)

Worksheets("Sheet1").Range("A2").Copy r
r.Offset(, col).Value = Worksheets("Sheet1").Range("C2").Value
End With
Set r = Nothing
End Sub
ご参考になれば。（名前がない時のエラー処理はしてませんけど）

回答No.2

hige_082

n-junさんには勉強させて戴いています、先日は有難う御座いました。

質問者さん、失礼いたしました
本題です
処理的には、そんなに難しいことではないと思います
もっと簡単に考えてみては
最初は手作業を、そのままの順序でマクロ化したほうが、覚えやすいと思いますよ

手順としては
１　Sheet1の各データを覚える
２　Sheet2で日付列の最初の空白行を見つけ、何行目かを覚える
３　空白行に日付を入力
４　氏名を元に列を探し、何列目かを覚える
５　覚えた行列を元に、成績を入力
こんな感じではないでしょうか
これを参考にマクロを作成してみます
’------------------------------------------------
Sub test()
Dim 行 As Long
Dim 列 As Long
Dim 日付 As String
Dim 氏名 As String
Dim 成績 As Integer

'１　Sheet1の各データを覚える
'各データを変数に代入します
Sheets("sheet1").Select
日付 = Range("A2").Value
氏名 = Range("B2").Value
成績 = Range("C2").Value

'２　Sheet2で日付列の最初の空白行を見つけ、何行目かを覚える
Sheets("sheet2").Select
'開始行を3行目に設定しています
行 = 3

'日付列の空白行を探します　Do　～　Loop
Do
'セルが空白("")かどうか調べます　If　～　End　If
If Cells(行, 1).Value = "" Then
'セルが空白の場合の処理
'３　空白行に日付を入力
Cells(行, 1).Value = 日付
'繰り返し処理を終了します
Exit Do
End If
'セルが空白でない場合の処理、次行へ
行 = 行 + 1
Loop

'４　氏名を元に列を探し、何列目かを覚える
'開始列を2列目に設定しています
列 = 2

'氏名を元に列を探します　Do　～　Loop
Do
'氏名が同じかどうか調べます　If　～　End　If
'同じであれば、繰り返し処理を終了します
If Cells(2, 列).Value = 氏名 Then Exit Do
'違っていれば、列を1つ右へ
列 = 列 + 1
Loop

'５　覚えた行列を元に、成績を入力
Cells(行, 列).Value = 成績

End Sub
’---------------------------------------
自分で理解できない処理(コマンド)は使用すべきではないと思います
後々、メンテナンスが出来ないからです
変数も日本語はお薦めできないのですが、なれないうちはありかなと思います