【Excel VBA】繰り返し処理と文字列の転記について

実現したいこと

Excel VBA で、データベースへ取り込むためのマスターシートを作成中です。
VBAは他の方が作ったものを業務で使用していたことは多々ありましたが、
自分でゼロベースから作成するのが、今回初めてになります。
色々調べて、何とか少しずつ理解し、進めているのですが、
上手くいかないことが多く、質問させていただきました。
・・・超初心者で恥ずかしいですが、今後のためにも習得したいです。
どなたかご教示いただけると幸いです。宜しくお願い致します。

【やりたいこと①】
シート①にあるデータを、必要な項目だけを抜粋して、シート②に転記したい。
この時シート①にあるデータは、毎月行数が変わるので、
何行目まで必要になるか不明。
また、B列からD列の値がブランクでも、E列以降に値が入っていたら、
その行はシート②に転記が必要。

ある特定の文字列(例えば"小計")がある行まで処理が進んだら、
その行以降はシート②に転記せず終了する。

文章で表しにくかったので、画像を。。。
例えば、品目が「バナナ」で、2行目はA列からG列まで値が入っているので、
これは2行目を全てシート②へ転記。
3行目はA列からC列はブランク⇒C列からG列まで値が入っているので、
このC列からG列までの値を上記で転記した行の下に追記。
7行目まで、同じ処理をしたい。
D列の＜小計＞がある行は転記不要なので、この"＜小計＞"の文字列に来たら、
転記せず、次の処理に進みたい。

次の処理とは、
品目が「マンゴー」で、
10行目はA列からG列まで値が入っているので、
これは10行目を全てシート②へ転記。
11行目から13行目まではA列からC列はブランク⇒C列からG列まで値が入っているので、このC列からG列までの値を上記で転記した行の下に追記。
*「バナナ」の時と同じ要領で行いたいです。

シート②の貼付先シートの完成図は
以下の画像のようになるように処理を行いたいです(可能でしたら)

【やりたいこと②】
シート①にある、該当するセルの値(文字列)を、シート②に値として転記したいが、
そのシート①にあるセルの値(文字列)は、行・列ばらばらに入っているので、
繰り返し処理がうまく書けない。
色々やっても自分で書いたソースでは、値を抽出できなかったので、
恥ずかしながら、この処理は「マクロの記録」で行ったものです。単純にシート①にある必要な値をコピペでシート②に貼り付けした作業です。

【やりたいこと③】
シート①のあるセルに入っている値を、シート②の所定の箇所に転記した際、
数字が一桁なら、頭に一つ0をつけて表示したい。その時この抽出した値の
先頭に"WK"という文字列をつけて、"WK01"、"WK02"～"WK15"などと表示させたい。

私の書き方が誤っているせいだと思うのですが、
一つのプロシージャ内に、まとめて処理を記述すると、
必ずどちらかが動かず(もしくはエラーが出ました)、
処理が進まないので、今はひとまずVBAの基本の基本から手を動かして覚えなくては！
と思い、一つの処理に対して、一つのソースコードを書いています。

該当のソースコード

【やりたいこと①のソースコード】

Sub Weeklyシート加工()
Dim S1 As Worksheet, S2 As Worksheet

'S1は"Weekly"シート
'S2は"Weeklyシート加工"シート

    Set S1 = Worksheets("Weekly") '元データ
    Set S2 = Worksheets("Weeklyシート加工")　'転記先

'"Weekly"シート(元データ)の値を"Weeklyシート加工"シート(貼付先)に転記する
    S1.Range(S1.Cells(5, 2), S1.Cells(5, 9)).Copy S2.Range(S2.Cells(2, 3), S2.Cells(2, 10))
    
End Sub

⇒S1.Range(S1.Cells(5, 2), S1.Cells(5, 9)).Copy S2.Range(S2.Cells(2, 3), S2.Cells(2, 10))
この部分を繰り返しすればいいのかも知れませんが、loop処理方法が分かりません。シートとセルの指定で混乱してしまい、指定の行まで順に処理を進め、上記に記載した、「B列からD列の値がブランクでも、E列以降に値が入っていたら、
その行はシート②に転記が必要。

ある特定の文字列(例えば"小計")がある行まで処理が進んだら、
その行以降はシート②に転記せず終了する。」
という処理をしたいです。

【やりたいこと②】のソースコード

Sub WK抽出()
'
' CalendarからWK_No.を抽出
    
    ActiveCell.FormulaR1C1 = "='[2019 Calendar FM.xlsx]Calendar'!R9C9"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "='[2019 Calendar FM.xlsx]Calendar'!R10C9"
    Range("E5").Select
    ActiveCell.FormulaR1C1 = "='[2019 Calendar FM.xlsx]Calendar'!R11C9"
    Range("E6").Select
  ・・・・・以下同上と同じ処理を繰り返しています。
    ActiveCell.FormulaR1C1 = "='[2019 Calendar FM.xlsx]Calendar'!R32C36"
    Range("E75").Select

End Sub

Calendarのイメージ

【やりたいこと③】のソースコード

Sub 値に変換()
  
    Range("E3:E74").Select
    Range("F3:F74").Select
    
     Range("F3:F74").Value = Range("E3:E74").Value
  
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-72
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
  
End Sub

Sub 【やりたいこと③　転記用データ()　⇒頭に"WK"の文字列をつけるソースコード】

Sub 転記用データ()

ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",""WK"" & RC[-1],"""")"
    Range("G3").Select
    Selection.AutoFill Destination:=Range("G3:G74")
    Range("G3:G74").Select
    ActiveWindow.SmallScroll Down:=60
    
Range("G3:G74").Value = Range("G3:G74").Value
  
End Sub

【やりたいこと②と③のイメージ】

赤枠内の値(文字列として)、別シートに転記したい。
*下記の自分のソースコードで実行すると、文字列として抽出したいのに、
計算式が入った状態でしか抽出できず、以降の作業でエラーを出さないために、
値で取るようにと言われています。なので、自分で考えたのが、次の画像に
あるように、隣の列で文字列に変換する処理です。
この文字列に変換した値を、さらに隣の列"DB用"に、
値が一桁の数字なら頭に0をつけて見た目を揃え、更にその文字列の頭に
"WK"を付ける処理を行いたいです。

宜しくお願い致します。
teratailに登録したばかりで、質問文がわかりににく、
申し訳ございません。

m.ts10806

2019/03/05 06:40

タイトルの「【Excel VBA】【初心者】」は質問のつけるタグなり初心者マークで対応可能なので要件をきちんとタイトルだけで見せるためにも削っていただいた方が良いかと。あとコードはマークダウンのcode機能を利用してご提示ください。 https://teratail.com/help#about-markdown

carrin

2019/03/05 06:44

ご教示ありがとうございます。修正いたします。

coco_bauer

2019/03/05 06:55

複数の事を同時に行うことは無理なので、順番にやりましょう！　やりたいことが①、②、③とあるのですから、①、②、③の順で解決していくのはどうですか？　また、『行・列ばらばらに入っている』という特殊なデータを扱うのであれば、典型的なデータの例を示してください。イメージできないデータを処理するプログラムを作るのはむつかしいですから。　「B列からD列の値がブランクでも、E列以降に値が入っていたら」というような条件・制約があるのなら、その全てを質問に列記してください。そうした情報が無いと完全なプログラムを作れません。

carrin

2019/03/05 07:48

ご教示ありがとうございます！質問内容を修正致しました。これでもわかりにくいかもしれません・・・すみません。

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

回答5件

ベストアンサー

＞必ずどちらかが動かず処理が進まないので、一つの処理に対して、一つのソースコードを書いています。
これは正解だと思います。
まとめて処理を書くと、意図せず影響を与えてしまうこともありますし、問題点の切り分けという意味でも別々にした方が管理しやすいです。

個々が正常に動作するようになったら、必要に応じてそれらを連続で呼び出す関数を作成すればいいのです。

ただ、トータルではDB出力のための情報集めなのでしょうが、①と②③では対象シートなど極端に処理条件が異なるようですので、質問するうえでは別々にしていただいた方が良かったかもしれません。
アドバイスまで煩雑になってしまいますので。

さて。
現状はやりたいことがたくさんあって、ちょっと整理ができなくなっているようですね。

まずそれぞれ整理しながら検討を進めましょう。

やりたいこと①について

ループ方法にお悩みとのことですが、その前に検討すべきことがあります。
・どこからどこまでループするのか？
つまり対象範囲の決定です。

文中では「＜小計＞を見つけたら処理終了」のように記載されているところもありますが、実際は「＜小計＞を見つけたら次にA列に値が入力されている行まで読み飛ばして処理を続ける」ですよね？

通常は空行を見つけたら終了、とすることが多いのですが、今回の場合は＜小計＞の下に空行があり、そのあとも次のデータが続くようです。

となると、
・シート全体の中で、値が入力されている最終セルの行まで処理したら終了
もしくは
・A列に値が入っている最終行より下で＜小計＞行を見つけたら終了
といったあたりが終了判定となるでしょうか。

これを踏まえて、実際にやりたいことの全体を整理してみます。
・シート①のA～G列をシート②に転記する(Copyなど)
・その際、シート①のA～C列が空欄の場合は、前行と同じ内容で補う(If文など)
・特定の文字（"＜小計＞"など）を検出した場合、次にA列に値が入力されている行まで読み飛ばす(If文など)
・最終データ行までこれを繰り返す(For～Nextなど)
こんなところではないでしょうか？

    Dim S1 As Worksheet
    Dim S2 As Worksheet
    
    Set S1 = Worksheets("Weekly") '元データ
    Set S2 = Worksheets("Weeklyシート加工")  '転記先
    
    Dim iLastRow As Integer
    '最終データ行を取得
    iLastRow = S1.Range("A1").SpecialCells(xlLastCell).Row
    
    Dim iRowI As Integer    '読み取り行
    Dim iRowO As Integer    '出力行
    
    iRowO = 2
    
    Dim bSkip As Boolean    '読み飛ばしフラグ
    bSkip = False
    
    '2行目～最終データ行までループ処理
    For iRowI = 2 To iLastRow
        
        If S1.Cells(iRowI, "A") = "" Then
            If S1.Cells(iRowI, "D") = "＜小計＞" Then
                bSkip = True
            End If
        Else
            bSkip = False
        End If
        
        If bSkip = False Then
            'コピーする
            S1.Range(S1.Cells(iRowI, "A"), S1.Cells(iRowI, "G")).Copy S2.Cells(iRowO, "A")
            
            'A～C列が空欄の場合は前行の内容で補う
            If S1.Cells(iRowI, "A") = "" Then
                S2.Cells(iRowO, "A") = S2.Cells(iRowO - 1, "A")
            End If
            If S1.Cells(iRowI, "B") = "" Then
                S2.Cells(iRowO, "B") = S2.Cells(iRowO - 1, "B")
            End If
            If S1.Cells(iRowI, "C") = "" Then
                S2.Cells(iRowO, "C") = S2.Cells(iRowO - 1, "C")
            End If
            
            '出力行をインクリメント
            iRowO = iRowO + 1
        End If
        
    Next

やりたいこと②について

情報追記いただいたようですが、これでもまだ情報が足りないようです。
・カレンダーシートは12月まで横並びですか？
・コピー先となるシート(Janualyなど縦並びのシート)は、各月6thまであるようですが、存在しない週はどうしますか？

ちなみに、日付がその年の何週目なのかを返すDatePart関数というものがありますので、わざわざ他シートから取得しなくても算出できそうな気もします。

やりたいこと③について

極端な話、セルの書式を"WK"00にするだけでも見た目だけならWK01のようになるのですが、DB登録用となると見た目だけではダメですよね。

これもコードを見る限り、数式としてセルに出力しようとしているようですが、そこにこだわりはありますか？
おそらく数式で表現するよりVBA内で文字列整形してしまったほうが楽です。

Sub Sample()
    'A1: Jan 1:1/1
    'A2: Jan 2:1/8
    'A3: Jan 3:1/15
    'A4: Jan 4:1/22
    'A5: Jan 5:1/29
    'A6: Jan 6:""
    'A7: Feb 1:2/1
    'A8: Feb 2:2/8
    'A9: Feb 3:2/15
    
    'A1～A9に上記の日付が入力されている場合、B列・C列に何週目かを出力します
    Dim i As Integer
    Dim strVal As String
    For i = 1 To 10
        strVal = Cells(i, "A")
        If strVal <> "" Then
            Cells(i, "B") = DatePart("ww", strVal)
            Cells(i, "C") = "WK" & Right("00" & Cells(i, "G"), 2)
        End If
    Next
End Sub

とりあえずこんなところでしょうか。
長文になってしまいましたが、参考になれば幸いです。

投稿2019/03/05 09:41

jawa

総合スコア3020

carrin

2019/03/06 07:27 編集

ご回答ありがとうございます。記述いただいたソースを元に、試行錯誤しています。やりたいこと②について >・カレンダーシートは12月まで横並びですか？ ⇒いいえ。横並びではなく、4か月表示が3列です。画像を追加しました。 >・コピー先となるシート(Janualyなど縦並びのシート)は、各月6thまであるようですが、存在しない週はどうしますか？ ⇒存在しない場合はスキップさせて、翌月の1日の”WKxx”を表示させたいのですが、ロジックがわからないです・・・「空白の場合」で記述したのですが、スキップできませんでした。ロジックが分かっていないので当たり前ですよね。 ”DatePart関数”というものがあるのですね！他のシートを参照せずに、この関数で値が出せるなら私にはこのほうが分かりやすいかも！と思い、ソースを書き直したのですが、なかなかうまくいかないです。難しい・・・やりたいこと③について >これもコードを見る限り、数式としてセルに出力しようとしているようですが、そこにこだわりはありますか？ ⇒こちらは、まったくこだわりはございません。最終的に文字列として”WK01”、”WK02”と表示したいのです。画像に「値に変換」という列があるのは、自分で書いたコードだと、数式が入ってしまって、ごちゃごちゃ書き直しを繰り返してしまい・・・頭が整理できなくなり、一旦出てきた数式入りの値は正しいので、それを利用して文字列に置き換えたのです。この方法しか、私の知識では"文字列"として、セルに値を表示させることができなかったのです(涙) 何度も変換しないで、一回の処理で”WK01”～”WK23”・・と出せたらいいのですが・・やりたいこと①についてこちらのご回答もありがとうございます！ご記載いただいた箇所に沿ってまだ整理できていなく・・申し訳ございません。まだ頭の整理と、何度も書いたり消したりを繰り返してしまってまとめきれていないので、一からご回答くださったソースを元に再度やり直してみます！まだ解決まで時間がかかりそうです。記述いただいた内容を元に、頑張ってみます！

jawa

2019/03/06 08:03

②の説明が不足していたようですね。すみません。 ②③は関連する処理だったので、サンプルコードは③にまとめて記載させていただいておりました。さらに、③のサンプルコードの上部にA列の値を書いていたのですが、これも説明なしではわかり難かったですよね。 --- ②③については出力セルの座標が行・列ともに不明だったので、サンプルコードは「A列の日付を元に、B列に②、C列に③を出力する」ものとして作成しました。 DatePart関数の使い方については「VBA　DatePart」といったキーワードで調べていただければ見つかると思いますが、要するに「日付を渡してあげると、その年の何週目かを返してくれる」関数です。 Jan_1st:2019/01/01 Jan_2nd:2019/01/08 Jan_3rd:2019/01/15 Jan_4th:2019/01/22 Jan_5th:2019/01/29 Jan_6th:なし Feb_1st:2019/02/01 Feb_2nd:2019/02/08 Feb_3rd:2019/02/15 Feb_4th:2019/02/22 Feb_5th:なし Feb_6th:なしという日付をそれぞれ用意しておき、それをDatePart関数に渡してあげれば何週目かを取得できます。ちなみに余談になりますが、Excelシート上で`=WEEKNUM(日付)`という式を書いてもVBAのDatePart関数と同じ結果を得ることができると思います。今回はWKをつけるといった加工までして値で出力したいのでVBAの方が適切だと思いますが、参考までに。

carrin

2019/03/07 06:47 編集

再度ご回答くださり、誠にありがとうございます。詳しく書いていただき、もやもやした部分が解決できました。自分は加工が必要な元データから無理やり値を抽出しなくてはいけない！と、ロジックを組むことすら出来ていませんでした。 jawaさんの"日付を渡してあげると、その年の何週目かを返してくれる"というアドバイスを参考に、関数なども再度調べなおしたりし、エラーが多発⇒何度も書き直してを繰り返し、ひとまず「やりたいこと②」と「やりたいこと③」を完成させてみました。回答欄に載せてみました・・ソースが美しくないので恥ずかしいです。残りは①をこれからやり直していきます！

jawa

2019/03/07 07:18

ひとまず②③は形になったようで、よかったです。コードも拝見しましたが、きれいにかけていると思いますよ。既に解決済みにされたようですが、まだ①がありますね。何か詰まるところなどあれば、またこちらでも、新たなスレでも構いませんのでご質問ください。

carrin

2019/03/08 08:34

「やりたいこと①」ですが、jawaさんがご回答くださったソースを元に加工し、必要な値の転記ができました！本当にありがとうございます。転記後の不要な行(あるセルが空白なら、その行は不要にしたかったのです）の削除もできました！私が書いたソースは、ほかの方に分かりにくいソースなので、参考にならないと思いますが、備忘録も兼ねて解決欄の箇所に記述してみました。もしアドバイスなどあれば、コメントいただけるとありがたいです！この後さらに今作成しているファイルで、「ある特定の文字列なら、〇〇に文字列を変換して転記」などの処理が必要で、これから調べます・・・VBA、サクサク進める方を尊敬します！私はとっても時間がかかってしまいます(涙)

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

【やりたいこと①】について

小難しく考えなくても、
1）A列からC列を選択して、ホームタグ→編集→条件を選択してジャンプ→空白セル→OKとして、そのまま、「=A2」と入力して、Ctrlキーを押しながらEnterキー押下で入力を確定
2）D列を選択して、ホームタグ→編集→置換→検索する文字列：<小計>→置き換える文字列：空白のまま→OKとして小計の文字をクリア
3）ホームタグ→編集→条件を選択してジャンプ→空白セル→OKとして、Shiftキーを押しながらSpaceキー押下で行全体を選択して削除

の操作で希望のデータに加工できます。手動だと上手くいかないですけど。
その操作をマクロの記録をすれば、必要なコードが得られます。
なので不要な部分を取り除いたりすれば、完成かと思います。

例）

VBA
1Sub test()
2    '左から3列分のデータの補完
3    With Columns(1).Resize(, 3)
4        On Error Resume Next
5        .SpecialCells(xlCellTypeBlanks).Formula = "=A2"  '表の左側3列分のうちの空白セルにすぐ上のセルを参照する式を入れる
6        On Error GoTo 0
7        .Value = .Value                                 'セルの値を取り出し、セルの値にとして上書きする（数式を消す）
8    End With
9
10    '4列目が空白のセルの（小計行＆空白行の）削除
11    With Columns(4)
12        .Replace What:="<小計>", Replacement:=""        '「<小計>」という値のセルの値を消し、空白セルを検索キーとして検索する
13        On Error Resume Next
14        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete    '4列目が空白のセルの行全体を削除する
15        On Error GoTo 0
16    End With
17End Sub

ただし、上記のコードだとシート上の全てのセルに対して（すべての行に対して）操作を命令しているので、処理にもたつきます。
なので、セル範囲を出来るだけ限定することが肝要です。
今回の件の場合、
ActiveSheet.UsedRange
で、操作の対象を限定するとよいでしょう。
参考URL>>
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_cell.html#usedrange

【やりたいこと②】について
意味が解りません。
ビフォー＆アフターで説明してみては？

【やりたいこと③】について
画像で示されると、コピペが出来ないので、
こちらで、頑張ってテストデータを作る気になれません。
画像と合わせて、そのエクセルデータをCSV形式で保存して、
それをメモ帳で開いて、カンマ区切りの文字列を貼り付けてもらえば、
そのデータをこちらに取り込んで、コードを示すことも可能です。
（いつまでにというのは約束できません。毎日30分おきにここのサイトを見ているわけではないので。。。本業の合間に横槍入れてるだけなので、1週間後になる可能性もあります。まぁ、待ってたらだれかが回答してくれると思いますが。）

投稿2019/03/05 12:08

mattuwan

総合スコア2167

carrin

2019/03/06 07:30 編集

ご回答ありがとうございます。【やりたいこと①】を試しています。VBAの基本がまだ呑み込めていないので、シートの指定を自分の環境に合わせて行ってます。(エラーが出るので何度も繰り返しています(涙)) 【やりたいこと②】の質問そのものが分かりにくい記述で、申し訳ございません。時間を見て整理して、質問文を修正したいと思います。 URL,ありがとうございます！私はまだ基本が全然わかっていないので、セル範囲についてわかってきました！とても参考になります。まだまだ本作業の完成まで先が長そうですが、手を動かしながら勉強しています。記述いただいた内容を元に、頑張ってみます！

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

vba
1Dim sht1 As Excel.Worksheet
2Dim sht2 As Excel.Worksheet
3Dim row1 As Integer
4Dim row2 As Integer
5
6Set sht1 = ThisWorkbook.Worksheets("Sheet1")
7Set sht2 = ThisWorkbook.Worksheets("Sheet2")
8
9'下記コード中の4, 5, 6, 7等の数字はシートの何列目かを表しています。
10'row1はsht1（コピー元のシート）用の行方向のカウンタ
11'row2はsht2（コピー先のシート）用の行方向のカウンタ
12
13row1 = 1
14row2 = 1
15
16Do
17    If sht1.Cells(row1, 4) = "<小計>" Then Exit Do
18
19    If sht1.Cells(row1, 5) <> "" _
20       Or sht1.Cells(row1, 6) <> "" _
21       Or sht1.Cells(row1, 7) <> "" Then
22        sht2.Cells(row2, 4) = sht1.Cells(row1, 4)    'コピー
23        row2 = row2 + 1
24    End If
25
26    row1 = row1 + 1
27
28Loop

①だけの回答ですが、どうでしょうか？

投稿2019/03/05 08:21

firstlast

総合スコア138

carrin

2019/03/06 06:50

ご回答ありがとうございます。記述いただいたソースを元に、試行錯誤しています。こちらのソースを参考に、自分が作成しているファイルの列と行に置き換えて実行したら、「実行エラー”6”　オーバーフローしました。」と表示され、貼付先シートには今回必要ではない＜小計＞以降のデータがセルにコピーされてしまいました。自分の指定したセル番地に誤りがありそうですよね。今見直ししています。(慣れないので、ものすごく時間がかかってしまいます・・・) まだ解決まで時間がかかりそうですが、頑張ってみますね！

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

不要な行を削除する

Sub 不要行削除()

    Dim i As Long, x As Long
    Dim S2 As Worksheet
    Set S2 = Worksheets("〇〇シート加工")  '転記先

    '例としてF列の空白セルを選択
    Columns("H").SpecialCells(xlCellTypeBlanks).Select
    '選択したセルがある行全体を削除
    Selection.EntireRow.Delete
    '選択状態の解除（念の為）
    Application.CutCopyMode = False
    
    With Sheets("〇〇シート加工")
    x = .Cells(Rows.Count, "H").End(xlUp).Row 'F列最終行取得
    For i = x To 2 Step -1 '下から順に2行目まで数えていく
        If InStr("sort", StrConv(.Cells(i, "H").Value, vbLowerCase)) > 0 Then '"zeikin"の文字列を含んでいれば
            .Cells(i, "H").EntireRow.Delete '行削除
        End If
    Next i
    End With
    

End Sub

投稿2019/03/08 08:33

carrin

総合スコア15

「やりたいこと②」と「やりたいこと③」

Sub Calendar加工()
Dim ws As Worksheet, i As Long
Dim firstDay As Date

Dim strVal As String

'inputボックスに一日目を入力
'2019年なら"2019/01/01"とユーザーに入力してもらう
'年間カレンダーを作成するだけなので、この作業だけは年初1回だけでOK

firstDay = InputBox(Date, "最初の日を入力してください", "YYYY/MM/DD")

Set ws = Worksheets("Calendar加工")
With ws

 For i = 2 To 367 '一応少し余分にとっておく
       
  If i <> 2 Then
   .Cells(i, 1) = Format(.Cells(i - 1, 1) + 1, "YYYY/MM/DD")
  Else
   .Cells(i, 1) = Format(firstDay, "YYYY/MM/DD")
  End If
     
    '曜日(略
    .Cells(i, 2) = Format(.Cells(i, 1), "aaa")
    .Cells(i, 3) = "WK" & Format(DatePart("ww", .Cells(i, 1), , vbFirstJan1), " 00")

    Next i
    
End With

End Sub