VBA 表の途中範囲での最終行の求め方

Question

VBA　初心者です。請求書作成のマクロを組んでいる最中なのですが調べては試してをし、現在に至るのですが出来ないことが２点あります。

※一つ前の質問の改訂版です。色々と試した結果一つだけ問題解決しました・・・

①１件目のデータ基を請求書に転記するマクロは組めました。しかし、２件目以降のデータを対象の列から最終行を取得して貼り付ける。ということを行いたく、Cells(Rows.Count, "").End(xlUp).Row＆offsetを使うのは解るのですがデータ基の繰り返しForの値との組み合わせ？方がわかりません。

小計２のデータもあるため、ただ最終行取得では本来小計１に貼り付けたい内容が小計２に張り付けられてしまいました。

※また、案件コード・案件名は表題として扱いたいので項目ごとに記載ではなく、一行のみ記載したいです。（現在はセルの指定をしていますが、2件目のデータの際には案件コード等も変わるのでやはりoffset等での指示が必要ですよね・・・）

②データ基のブック名・シート名が一部変更になっても大丈夫なVBAを組もうと*を使って作ったのですがエラーが起きてしまいつくれませんでした。
ブック名・シート名共にD6までは固定で00101～どんどん変動していきます。
エラーの対応策をご教授頂けたらと思います。
※今は請求書作成をとりあえず先に。と１つの名前で作成しています。

周りにVBA組める人がいないのでここに頼ってしまい申し訳ありませんが宜しくお願い致します。

下記、現在作成したVBAとなります。
画像は追って添付します。
ーーーーーーーーーー
Sub 請求書作成()

'シートの指定
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim x As Long
Dim y As Long
Dim m As Long
Dim n As Long

Set wb1 = Workbooks("売上管理票(D600101).xlsx")
Set wb2 = Workbooks("請求書.xlsm")
Set sh1 = wb1.Worksheets("D600101")
Set sh2 = wb2.Worksheets("請求書")

x = 168: y = 17: m = 172: n = 39

        sh2.Cells(6, 2) = sh1.Cells(3, 14) '取引先名
   
     '小計１
    
   For x = 168 To 171
        
       With sh1.Cells(x, "AC")
          If IsNumeric(.Value) And .Value > 0 Then
           
           sh2.Cells(17, 2) = sh1.Cells(2, 8) '案件コード
           sh2.Cells(17, 3) = sh1.Cells(2, 14) '案件名
           sh2.Cells(y, 4) = sh1.Cells(x, 25) '項目
           sh2.Cells(y, 5) = sh1.Cells(x, 26) '数量
           sh2.Cells(y, 6) = sh1.Cells(x, 27) '単位
           sh2.Cells(y, 7) = sh1.Cells(x, 28) '単価
           sh2.Cells(y, 8) = sh1.Cells(x, 29) '金額
           y = y + 1
            
          End If
       End With
   Next x
     
     '小計2
    
    For m = 172 To 174
        
       With sh1.Cells(m, "AC")
        If IsNumeric(.Value) And .Value > 0 Then

          sh2.Cells(39, 2) = sh1.Cells(2, 8) '案件コード
          sh2.Cells(39, 3) = sh1.Cells(2, 14) '案件名
          sh2.Cells(n, 4) = sh1.Cells(m, 25) '項目
          sh2.Cells(n, 5) = sh1.Cells(m, 26) '数量
          sh2.Cells(n, 6) = sh1.Cells(m, 27) '単位
          sh2.Cells(n, 7) = sh1.Cells(m, 28) '単価
          sh2.Cells(n, 8) = sh1.Cells(m, 29) '金額
          n = n + 1
        End If
       End With
     
    Next m
End Sub

めぐみん_ · Accepted Answer

No.3です。

次のBook＆Sheetを取り込む際に『案件』についての情報は同じ値で宜しいのでしたっけ？
もし違うと言うならそれぞれの固定行を変数： y , n に変更してください。

極力既に作成されているコードに手を付けずに弄りました。
不備がありましたらご連絡を。

－－－－－－－－－－

Sub 請求書作成()

'シートの指定
Dim wb As Workbook
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim ch As Integer
Dim x As Long
Dim y As Long
Dim m As Long
Dim n As Long

Set wb2 = ThisWorkbook 'Workbooks("請求書.xlsm")
Set sh2 = wb2.Worksheets("請求書")

For Each wb In Workbooks
If wb.Name <> wb2.Name Then Set wb1 = wb 'Workbooks("売上管理票(D600101).xlsx")
Next

wb1.Activate
Set sh1 = wb1.ActiveSheet 'wb1.Worksheets("D600101")

wb2.Activate
ch = MsgBox("開かれてる売上管理票のブック名は　：" & wb1.Name & vbCrLf & _
            "選択されたシートは　　　　　　　　：" & sh1.Name & vbCrLf & "これで宜しいですか？", vbYesNo)

If ch = vbNo Then MsgBox ("[いいえ] が選択されましたので中止。"): Exit Sub

x = 168: y = IIf(sh2.Cells(17, 4).Value = "", 17, sh2.Cells(16, 4).End(xlDown).Row + 1)
m = 172: n = IIf(sh2.Cells(39, 4).Value = "", 39, sh2.Cells(38, 4).End(xlDown).Row + 1)

sh2.Cells(6, 2).Value = sh1.Cells(3, 14).Value '取引先名

'小計１

For x = 168 To 171

With sh1.Cells(x, "AC")
If IsNumeric(.Value) And .Value > 0 Then

sh2.Cells(17, 2) = sh1.Cells(2, 8) '案件コード
sh2.Cells(17, 3) = sh1.Cells(2, 14) '案件名
sh2.Cells(y, 4) = sh1.Cells(x, 25) '項目
sh2.Cells(y, 5) = sh1.Cells(x, 26) '数量
sh2.Cells(y, 6) = sh1.Cells(x, 27) '単位
sh2.Cells(y, 7) = sh1.Cells(x, 28) '単価
sh2.Cells(y, 8) = sh1.Cells(x, 29) '金額
y = y + 1

End If
End With
Next x

'小計2

For m = 172 To 174

With sh1.Cells(m, "AC")
If IsNumeric(.Value) And .Value > 0 Then

sh2.Cells(39, 2) = sh1.Cells(2, 8) '案件コード
sh2.Cells(39, 3) = sh1.Cells(2, 14) '案件名
sh2.Cells(n, 4) = sh1.Cells(m, 25) '項目
sh2.Cells(n, 5) = sh1.Cells(m, 26) '数量
sh2.Cells(n, 6) = sh1.Cells(m, 27) '単位
sh2.Cells(n, 7) = sh1.Cells(m, 28) '単価
sh2.Cells(n, 8) = sh1.Cells(m, 29) '金額
n = n + 1
End If
End With

Next m

End Sub

－－－－－－－－－－－－

売上管理票のＢｏｏｋは開いておき且つ必要なSheetを広げている状態からとなっております。

めぐみん_ · Answer

No.4です。

Dim yy As Long
Dim nn As Long

と言う２つの変数を追加します。

x = 168: y = IIf(sh2.Cells(17, 4).Value = "", 17, sh2.Cells(16, 4).End(xlDown).Row + 1):yy = y
m = 172: n = IIf(sh2.Cells(39, 4).Value = "", 39, sh2.Cells(38, 4).End(xlDown).Row + 1):nn = n

と y,n の初期値を yy,nn に代入します。

あとは先ほどの y,n に変更した『案件』の行を示す変数と yy,nn を入れ替えます。
この２つはループ中に +1 をされないので初期値のままのはずです。

めぐみん_ · Answer

まず請求書の小計１と２の境界線はその書式で固定されていると考えて構わないのでしょうか？
それともどちらかの増減により変動せざるを得ない状況が発生する場合はありますか？

スタイルとしては『売上管理票～.xlsx』を『作業者が自分で選択して開いてシートをアクティブにする。（エクスプローラーで）』なのか、
何らかの手段で自動化させようと考えているのか。
その場合組み合わせがどうなっているのかが不明になりますね。
次に呼び出すＢｏｏｋをどう選ばせるのかですので。

まぁ、まだ簡単に書けると思えるのは『請求書Ｂｏｏｋは開いたまま』『売上Ｂｏｏｋを選んで開き、必要なシートをアクティブにしておく』と言う手作業を行い、
あとはマクロを実行。
請求書に値が書き込まれたら一旦マクロは終了。
次のブックを開きシートをアクティブしてマクロを実行。
ってのが回答する上では楽ですよね。
ただ小計２がない場合、小計１の対になっていたデータ行は飛ばして次のデータを取り込むのか否か・・・

小計１・２の項目行が固定であれば、最終行は下から調べる（xlUp）のではなく、上から調べる（xlDown）方法もありますよ。

めぐみん_ · Answer

No.1です。

＞１件目のデータ基を請求書に転記するマクロは組めました。

『１件目のデータ基』って何を指しているのでしょう？
そして『２件目以降』とは？
次のシート？次のブック？の事かな。

コード的には『Workbooks("売上管理票(D600101).xlsx")』の『wb1.Worksheets("D600101")』のＹ列より右のデータを取得してますよね？
でも画像的に『２件目以降』と言えるようなものがどれなのか不明。
もしかして提示しているコードの該当する『列番号』はダミー？

めぐみん_ · Answer

『請求書』の書式なので本来画像の状態が提出するフォーマットになるのでは？
そう考えると最終行取得云々よりも書き込み開始行（y , n ）を使ったままで良いように思えるのですが、
例えば小計１で空白行が多いのが気に入らないから件数に合わせると言う改善を検討されているのでしょうか？
又は『小計３』や『小計４』など増える場合もあるのでそれらを調整したいとか？

あと

sh2.Cells(17, 2) = sh1.Cells(2, 8) '案件コード
sh2.Cells(17, 3) = sh1.Cells(2, 14) '案件名

この２行（ともう１組）は For ~ Next の前に実行しても良いのでは？
ループ中何度も同じ所に同じ値を入れてる訳でちょっときになりました。

VBA 表の途中範囲での最終行の求め方

No.3です。

No.4です。

まず請求書の小計１と２の境界線はその書式で固定されていると考えて構わないのでしょうか？

No.1です。

『請求書』の書式なので本来画像の状態が提出するフォーマットになるのでは？

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング