①入力シートの最後のセルまで処理されない問題
これは、最初に表示しているシートの問題ではないでしょうか?
ループカウンタに使用している
Cells(Rows.Count, 1).End(xlUp).Row
の部分は、アクティブシートが対象になっていると思います。
確認用シートがアクティブな状態でマクロを実行すると、40行目程度までしか処理されないと思います。
ここは明示的に
Worksheets("入力").Cells(Rows.Count, 1).End(xlUp).Row
としてあげたほうがよいでしょう。
②日付が変わった時に列移動しかしていない
他の方からも指摘があるように、日付けが変わった時にデータを書かずに読み取り行を次に進めてしまっています。
ループ内でループ変数の値を変更するのはバグや無限ループのもとになるので、行を戻してあげるよりもデータを書いてしまった方がよいでしょう。
以上を踏まえたソースコードです。
Sub 台帳転記()
Dim gyod
Dim gyoi
Dim hir
Dim hig
Dim retu
hir = 3
gyoi = 5
retu = 2
For gyod = 2 To Worksheets("入力").Cells(Rows.Count, 1).End(xlUp).Row
If Worksheets("確認用").Cells(2, hir) <> Worksheets("入力").Cells(gyod, 1) Then
hir = hir + 2
gyoi = 5
End If
Worksheets("確認用").Cells(gyoi, hir - 1) = Worksheets("入力").Cells(gyod, 3)
Worksheets("確認用").Cells(gyoi, hir) = Worksheets("入力").Cells(gyod, 4)
gyoi = gyoi + 1
Next
End Sub
結果的に「日付が違っていたら出力位置を2列移動して5行目に戻す」という判定に変更しています。
追加修正
上記のコードでは入力シートの日付の並びと出力シートの日付の並びが一緒でない場合(日付けが飛んだりしている場合)に、関係ない日付の列にデータを出力してしまうケースが存在しました。
そのようなデータが想定される場合は、出力シートで正しい日付の列を見つけるまでループしてあげる必要があります。
Sub 台帳転記()
Dim gyod
Dim gyoi
Dim hir
Dim hig
Dim retu
hir = 3
gyoi = 5
retu = 2
For gyod = 2 To Worksheets("入力").Cells(Rows.Count, 1).End(xlUp).Row
Do
If Worksheets("確認用").Cells(2, hir) = Worksheets("入力").Cells(gyod, 1) Then
'日付けが一致した場合はDoループを抜ける
Exit Do
Else
'日付けが一致しない場合は出力位置を変更
hir = hir + 2
gyoi = 5
End If
'確認用シートの日付が""の列になるまでに一致する日付けが見つからなかったら処理終了
If Worksheets("確認用").Cells(2, hir) = "" Then Exit Sub
Loop
Worksheets("確認用").Cells(gyoi, hir - 1) = Worksheets("入力").Cells(gyod, 3)
Worksheets("確認用").Cells(gyoi, hir) = Worksheets("入力").Cells(gyod, 4)
gyoi = gyoi + 1
Next
End Sub
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。