【VBA】最終行に転記

Question

前提・実現したいこと

（同一book）
【入力】シートに入力したものを【点検履歴】シートの最終行に転記したいです。
↓入力シート（sheet9)

↓点検履歴（sheet8)

発生している問題・エラーメッセージ

最終行の取得がうまくいかず、一行目を更新してしまう。

現在のコード

Sub データ読込()

Worksheets("点検履歴").Range("a2").Value = Worksheets("入力").Range("b1").Value
Worksheets("点検履歴").Range("b2").Value = Worksheets("入力").Range("b2").Value
Worksheets("点検履歴").Range("c2").Value = Worksheets("入力").Range("b3").Value
Worksheets("点検履歴").Range("d2").Value = Worksheets("入力").Range("b4").Value
Worksheets("点検履歴").Range("e2").Value = Worksheets("入力").Range("b5").Value
Worksheets("点検履歴").Range("f2").Value = Worksheets("入力").Range("b6").Value
Worksheets("点検履歴").Range("g2").Value = Worksheets("入力").Range("b7").Value
Worksheets("点検履歴").Range("h2").Value = Worksheets("入力").Range("b8").Value
Worksheets("点検履歴").Range("i2").Value = Worksheets("入力").Range("c2").Value

End Sub

最終行の取得含めスマートな転記方法がございましたら
お力を貸していただきたいです。

Comments

[Zuishin]

なぜフォームを使わないのでしょう？

[sm0715]

すみません。ユーザーフォームを作成したところ最終行の取得方法がわからなかったので手っ取り早くエクセルで作成してみました。また勉強します。

Answer 1

手作業で、コピーして、貼り付けオプションで「行列の入れ替え」をチェックして貼り付けるのを、
マクロ記録して、不要な部分を削除すると、

Public Sub データ読込()
    Dim rngTo As Range
    
    Set rngTo = Worksheets("点検履歴").Cells(Rows.Count, 1).End(xlUp) '最終行
    Set rngTo = rngTo.Offset(1).Resize(, 8)   'コピー先のセル範囲
    
    With Sheets("入力")
        .Range("B1:B8").Copy
        rngTo.PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
        rngTo.Offset(, 8).Resize(, 1).Value = .Range("c2").Value
    End With
End Sub

Transpose関数という便利なものがあるので、それを使うとクリップボード経由しなくても
行列を入れ替えて貼り付け可能。

Public Sub データ読込_改()
    Dim rngFrom As Range
    Dim rngTo As Range
    
    Set rngFrom = Worksheets("入力").Range("B1:B8") 'コピー元のセル範囲
    
    Set rngTo = Worksheets("点検履歴").Cells(Rows.Count, 1).End(xlUp) '最終行
    Set rngTo = rngTo.Offset(1).Resize(, 8)   'コピー先のセル範囲
    
    '行列を入れ替えて転記
    rngTo.Value = WorksheetFunction.Transpose(rngFrom.Value)
    rngTo.Offset(, 8).Resize(, 1).Value = Sheets("入力").Range("c2").Value
End Sub

Comments

[sm0715]

ご回答ありがとうございます！
Transpose関数というものがあるんですね。勉強になります！

教えていただいたコードですと
次回項目が増えた場合も対応しやすくなりますね助かりました！！

Answer 2

必須項目（絶対空白にしない項目）の列（例えば、お客様Noが必須項目なら、点検履歴シートのA列）を２行目から順に見ていって、空白が見つかったら、その行に入力シートの内容を転記する
というような方法が良いと思います。

ざっと書いてみたのが、下のコードです。
必須項目が空白の時には点検履歴シートへの書き込みをしないようにする機能を付け加える必要があります（必須項目が空白のまま点検履歴シートに書き込むと、その行は次の書き込みに使われてしまうため）

Sub データ読込()
  dim row as Long,  i as Long

  const requredCol = 1 '１列目(A列）に必須項目が入る
  row = 2 '点検履歴シートの２行目から点検履歴が記入されているので、調べ始めるのは２行目から

  'A列のセルの内容が空白の行を探す（空白でなければ次の行を調べる）  
  do while ( Worksheets("点検履歴").cells(row,requiredCol).value <> "")
    row=row+1
  Loop
  'ここまでで、rowに新しい点検履歴を記入する行番号が入っている。

  '入力シートのB1:B8の内容を点検履歴シートの1から8列目(aからh列)に入れる
  'ループ変数 i が点検履歴シートでは列番号、入力シートでは行番号に使われている
  for i=1 to 8
    Worksheets("点検履歴").cells(row,i).value = Worksheets("入力").cells(i,2).value
  next i

  '内容を入れる　Worksheets("点検履歴").cells(row,9)は、row行のH列のセル
  'Worksheets("入力").cells(2,3)は、C3セル
  Worksheets("点検履歴").cells(row,9).value = Worksheets("入力").cells(2,3).value
End Sub

Comments

[sm0715]

ご回答ありがとうございます！
入力必須項目は入力規則で制限して対応できました！ありがとうございます。

Answer 3

私なら、一番下( あるいは一番右 ) のデータを取得するなら、

「Excel VBA 最終行」で検索したところ、

No.8 ワークシートの最終行、最終列を取得する　がヒットしました。

これを使います。

上記ページの "<S2> 下方向に最終行を検索する" ですね。

また、コードが読みづらいです。

質問や回答するときの "</>" っていうボタンがあります。それを押して、出てきた"言語名"に言語名を記載し、"コード"の部分にコードを記述してください。

そのままではインデントが無視されるため、読みにくいです。

次に、ちょっとヒント。

Sub データ読込()
    Worksheets("点検履歴").Range("a2").Value = Worksheets("入力").Range("b1").Value
    Worksheets("点検履歴").Range("b2").Value = Worksheets("入力").Range("b2").Value
    Worksheets("点検履歴").Range("c2").Value = Worksheets("入力").Range("b3").Value
    Worksheets("点検履歴").Range("d2").Value = Worksheets("入力").Range("b4").Value
    Worksheets("点検履歴").Range("e2").Value = Worksheets("入力").Range("b5").Value
    Worksheets("点検履歴").Range("f2").Value = Worksheets("入力").Range("b6").Value
    Worksheets("点検履歴").Range("g2").Value = Worksheets("入力").Range("b7").Value
    Worksheets("点検履歴").Range("h2").Value = Worksheets("入力").Range("b8").Value
    Worksheets("点検履歴").Range("i2").Value = Worksheets("入力").Range("c2").Value
End Sub

となっていますね。

これだと冗長ですので、Rangeじゃなくて Cellsを使いましょう。

ただ単に Range(...) を Cells(...) に置き換えるだけです。

Cellsは

Cells( 行, 列 )

となっていたはずです。

よって、

' Worksheets(シート名).Cells(行,列).Value
Worksheets("シート1").Cells(1,2).Value = "A2"

みたいにできます。

これとFor文を掛け合わせて、

For i = 0 To 10 ' 先ほどの 最終行を取得するやつのでもいいが。
    Worksheets("スタック").Cells( 1, i ).Value = ...
Next i

みたいにすればもうちょっとマシになるかも。

( 例は全く関係ないですが。 )

あと、Worksheetsも Sheetsだったかな。

それで番号で指定できたはず。

Sheets(1).Cells(1,1).Value = "シート1のA1"

Comments

[sm0715]

ご回答ありがとうございます！
すみませんそのような質問方法があったのですね、、、次回からのそのように質問させていただきます。
Cells( 行, 列 )を利用して書き直してみます。ありがとうございました。

Answer 4

いろいろな実装法がありますが、私のおすすめは以下のような方法です。

まず、「最終行」の検出方法ですが、これは Range オブジェクトの End メソッドを利用します。これは、ワークシート上で「END」キーを押してからカーソル移動キー「→、↑、←、↓」を押すのと同じ動作をします。
それで、ちょうどワークシートの最下行を選択しておいて、「END＋↑」を入力するのと同様に以下を実行します。

Cells(Rows.Count, 1).End(xlUp)

「Rows.Count」というのはExcelのワークシートの最大行数のことで、その１列目を選択してから「END＋↑」を押すと、データ入力済みの最終行にカーソルが移動します。その次の行が、新規データを入力したい行ということになります。

次に、メンテナンス性を良くするために、「入力」シートのフィールド（セル）に「名前」を付けます。

アクセスしやすいよう、「ブック」に対する名前として定義します。定義した結果は以下のような感じです。

名前を付けたセルには Range("お客様No") のようにアクセスできるのですが、実はこれを [名前] のように省略して記載することができます。

以上のポイントを踏まえて実装すると以下のような感じです。

Sub データ読込()
  Dim lngEndRow As Long
  
  With ThisWorkbook.Worksheets("点検履歴")
    lngEndRow = .Cells(Rows.Count, 1).End(xlUp).Row
    
    .Cells(lngEndRow + 1, 1).Value = [お客様No].Value
    .Cells(lngEndRow + 1, 2).Value = [分類].Value
    .Cells(lngEndRow + 1, 3).Value = [アポ日].Value
    .Cells(lngEndRow + 1, 4).Value = [アポ日_時間].Value
    .Cells(lngEndRow + 1, 5).Value = [点検日].Value
    .Cells(lngEndRow + 1, 6).Value = [点検日_時間].Value
    .Cells(lngEndRow + 1, 7).Value = [立会人].Value
    .Cells(lngEndRow + 1, 8).Value = [担当].Value
    .Cells(lngEndRow + 1, 9).Value = [内容].Value
  End With

End Sub

これで結構見やすくなりましたので、メンテナンス性も上がります。

以上、ご参考になれば幸いです。

Comments

[sm0715]

ご回答ありがとうございます。早速試させていただきました！うまく起動して希望通りの結果になりました。【名前】を定義することで他の人もコードを修正しやすくなりました。初心者の私でもわかりやすかったです。

Answer 5

点検履歴のシートには転記前に１行空行を挿入するのはどうですか?

Comments

[sm0715]

ご回答ありがとうございます！さっそく1行挿入するコードを追加で入れてみた所うまくいきました！ありがとうございます。