都道府県穴埋めゲーム

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

Sheet1
   A   B   C   D  
1 日付 氏名 成績 区分
2 9/23 佐藤 95  優

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

Sheet2
   A   B   C   D   E   F  G
1       1組       2組
2    田中 佐藤 小林 近藤 三浦 遠藤
3 9/19 90 
4 9/21         80
5 9/21    95
6 9/21            95
7 9/22                 95

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

Sheet2
   A   B   C   D   E   F  G
1       1組       2組
2    田中 佐藤 小林 近藤 三浦 遠藤
3 9/19 90 
4 9/21    95   80  95
5 9/21    
6 9/21            
7 9/22                 95

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

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

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

A 回答 (2件)

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
ご参考になれば。(名前がない時のエラー処理はしてませんけど)
    • good
    • 0

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



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

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

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

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

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

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

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

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

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

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