特定の行をスキップしながらIf構文

前提・実現したいこと

[日付を参照したい]
あらかじめ1〜30日まで日付が挿入された請求書シートに、
別シートの複数データを該当の日付と同じ行にコピーするマクロを作成したいです。

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

いまの私の作成したIf構文を使用したVBAコードでは上から順に詰めてコピーされ、
1日目から順にあらかじめ振られた日付を無視して貼り付けられてしまいます。
日付を参照してコピーをすることで、データのない日は空欄のままにしたいです。

※VBA初心者です。

エラーメッセージ

該当のソースコード

VBA
1Sub 会社ごとの受注データを請求書へ()
2
3    '請求書のタイトル行を取得する
4    Dim r As Integer
5    r = Worksheets("請求書").Range("B17").Row
6
7    '請求書へ受注データを書き写す
8    Dim LastRow As Integer
9    LastRow = Worksheets("受注一覧").Cells(Rows.Count, 2).End(xlUp).Row
10
11    Dim i As Integer
12    For i = 2 To LastRow
13
14        If Worksheets("請求書").Range("B5").Value = _
15            Worksheets("受注一覧").Range("B" & i).Value Then
16            r = r + 1
17
18                '日付 A2 - B18
19                Worksheets("請求書").Range("B" & r).Value = _
20                    Worksheets("受注一覧").Range("A" & i).Value
21                '商品 C2 - C18
22                Worksheets("請求書").Range("C" & r).Value = _
23                    Worksheets("受注一覧").Range("C" & i).Value
24                '単価 D2 - E18
25                Worksheets("請求書").Range("E" & r).Value = _
26                    Worksheets("受注一覧").Range("D" & i).Value
27                '個数 E2 - F18
28                Worksheets("請求書").Range("F" & r).Value = _
29                    Worksheets("受注一覧").Range("E" & i).Value
30                '料金 G2 - H18
31                Worksheets("請求書").Range("H" & r).Value = _
32                    Worksheets("受注一覧").Range("G" & i).Value
33        End If
34    Next i
35End Sub

試したこと

And構文をIf構文へ追加しようとしましたが、いまいちどう書けばよいかわかりません。

Microsoft Excel for Mac 16.28 (最新版)

meg_

2019/09/29 01:21

「If Worksheets("請求書").Range("B5").Value = _」で「B5」のセルが固定されていますが、ここは問題ないですか？

行動規範の内容に同意します

回答3件

あらかじめ1〜30日まで日付が挿入された請求書シートに、
別シートの複数データを該当の日付と同じ行にコピーする

Worksheets("請求書").Range("A18")が1日で、
そこから下に2日、3日と続くんですよね？
ならば、探さなくても
30日ならば、

Worksheets("請求書").Range("B18").Cells(30,1)
が、
30日のセルになります。

同じようにRangeプロパティでも相対位置が示せます。

Worksheets("受注一覧").Range("G1").Range("B1")

変数を上手く使いながら、セルの位置をこんな感じで示せれば、
すっきり読めるコードになるのではないでしょうか？

ExcelVBA
1Sub test()
2    Dim rngTable As Range   '請求書転記基準セル
3    Dim rngList As Range    '受注一覧データセル範囲
4    Dim r As Range          'セル範囲中の各行
5    Dim ix As Long          '相対の行数（＝日付）
6    
7    'セル範囲の定義
8    Set rngTable = Worksheets("請求書").Range("B18").Resize(31, 8)
9    Set rngList = Worksheets("受注一覧").Range("A1").CurrentRegion
10    'セル範囲からタイトル行を除く
11    Set rngList = rngList.Resize(rngList.Rows.Count - 1).Offset(1)
12    
13    '一覧セル範囲を行毎に繰り返し
14    For Each r In rngList.Rows
15        ix = Day(r.Cells(2).Value)
16        rngTable.Cells(ix, "B").Value = r.Range("A1").Value '日付
17        rngTable.Cells(ix, "C").Value = r.Range("C1").Value '商品
18        rngTable.Cells(ix, "E").Value = r.Range("D1").Value '単価
19        rngTable.Cells(ix, "F").Value = r.Range("E1").Value '個数
20        rngTable.Cells(ix, "H").Value = r.Range("G1").Value '料金
21    Next
22End Sub