ループしよう。【VBA】

経緯

VBAで同じような処理でとても長くなったので、ループできないか考えてみました。

コード

まずコードです。最終行を検出して、いろんな列の２列目にある数値を最終行までコピーしています。

Sub CopyFormulasDown()
    Dim ws As Worksheet
    Dim lastRow As Long

    ' ワークシートの設定
    Set ws = ThisWorkbook.Sheets(1)

    ' 列Aの最終行を検出
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 各列の2行目の数式を3行目から最終行までコピー
    If lastRow > 2 Then
        ws.Range("AH2").Copy Destination:=ws.Range("AH3:AH" & lastRow)
        ws.Range("AI2").Copy Destination:=ws.Range("AI3:AI" & lastRow)
        ws.Range("AJ2").Copy Destination:=ws.Range("AJ3:AJ" & lastRow)
        ws.Range("AK2").Copy Destination:=ws.Range("AK3:AK" & lastRow)
        ws.Range("AL2").Copy Destination:=ws.Range("AL3:AL" & lastRow)
        ws.Range("AM2").Copy Destination:=ws.Range("AM3:AM" & lastRow)
        ws.Range("AN2").Copy Destination:=ws.Range("AN3:AN" & lastRow)
        ws.Range("AO2").Copy Destination:=ws.Range("AO3:AO" & lastRow)
        ws.Range("AP2").Copy Destination:=ws.Range("AP3:AP" & lastRow)
        ws.Range("AQ2").Copy Destination:=ws.Range("AQ3:AQ" & lastRow)
        ws.Range("AR2").Copy Destination:=ws.Range("AR3:AR" & lastRow)
        ws.Range("AS2").Copy Destination:=ws.Range("AS3:AS" & lastRow)
        ws.Range("AT2").Copy Destination:=ws.Range("AT3:AT" & lastRow)
        ws.Range("AU2").Copy Destination:=ws.Range("AU3:AU" & lastRow)
        ws.Range("AV2").Copy Destination:=ws.Range("AV3:AV" & lastRow)
        ws.Range("AW2").Copy Destination:=ws.Range("AW3:AW" & lastRow)
        ws.Range("AX2").Copy Destination:=ws.Range("AX3:AX" & lastRow)
        ws.Range("AY2").Copy Destination:=ws.Range("AY3:AY" & lastRow)
        ws.Range("AZ2").Copy Destination:=ws.Range("AZ3:AZ" & lastRow)
        ws.Range("BA2").Copy Destination:=ws.Range("BA3:BA" & lastRow)
        ws.Range("BB2").Copy Destination:=ws.Range("BB3:BB" & lastRow)
        ws.Range("BC2").Copy Destination:=ws.Range("BC3:BC" & lastRow)
        ws.Range("BD2").Copy Destination:=ws.Range("BD3:BD" & lastRow)
        ws.Range("BE2").Copy Destination:=ws.Range("BE3:BE" & lastRow)
        ws.Range("BF2").Copy Destination:=ws.Range("BF3:BF" & lastRow)
        ws.Range("BG2").Copy Destination:=ws.Range("BG3:BG" & lastRow)
        ws.Range("BH2").Copy Destination:=ws.Range("BH3:BH" & lastRow)
        ws.Range("BI2").Copy Destination:=ws.Range("BI3:BI" & lastRow)
        ws.Range("BJ2").Copy Destination:=ws.Range("BJ3:BJ" & lastRow)
        ws.Range("BK2").Copy Destination:=ws.Range("BK3:BK" & lastRow)
        ws.Range("BL2").Copy Destination:=ws.Range("BL3:BL" & lastRow)
        ws.Range("BM2").Copy Destination:=ws.Range("BM3:BM" & lastRow)
        ws.Range("BN2").Copy Destination:=ws.Range("BN3:BN" & lastRow)
        ws.Range("BO2").Copy Destination:=ws.Range("BO3:BO" & lastRow)
        ws.Range("BP2").Copy Destination:=ws.Range("BP3:BP" & lastRow)
        ws.Range("BQ2").Copy Destination:=ws.Range("BQ3:BQ" & lastRow)
    End If
End Sub

という感じですごく長いコードになりました。

なので、これをループを使って、短く簡潔にしたいしたのが、以下のコードです。

Sub CopyFormulasDown()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim col As Long

    ' ワークシートの設定
    Set ws = ThisWorkbook.Sheets(1)

    ' 列Aの最終行を検出
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' AH列(列番号34)からBQ列(列番号69)までの数式をコピー
    If lastRow > 2 Then
        For col = 34 To 69  ' AH列からBQ列まで
            ws.Cells(2, col).Copy Destination:=ws.Range(ws.Cells(3, col), ws.Cells(lastRow, col))
        Next col
    End If
End Sub

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

ここまで読んでいただきありがとうございました。

スクールの紹介

【アイデミー】AIを学んで一発逆転のキャリアチェンジ！

最後に宣伝をさせてください。

夢見るAIエンジニアへ、今こそ一歩を踏み出せ！

最近、AI技術やデータサイエンスに興味を持ち始めたあなた。将来、AIエンジニアやデータサイエンティストとして活躍したいと考えているかもしれません。また、AIを使って業務課題や研究課題を解決したい、あるいは教養としてAIの知識を深めたいと思っている方もいるでしょう。

しかし、学び始めるとなると「どこから手をつけて良いのか分からない」「専門的すぎて理解できない」といった悩みが生じることも。そんなあなたのために、この3ヶ月間集中してAIプログラミングを習得するオンラインコーチングサービスがオススメです！

なぜこのサービスが選ばれるのか？その理由はこちら

1. 初心者から上級者まで
   完全なプログラミング初心者から研究者まで、幅広い方々に優良なコンテンツが提供されます。
2. 徹底的な進捗管理
   受講者の進捗をしっかりとチェックし、つまずきやすいポイントでのフォローが万全です。
3. 専属メンターによる徹底サポート
   AIの学び方から、実際の適用まで、専属のメンターが手厚くサポートします。
4. 場所を選ばず学べるオンライン完結
   東京以外の地域からも、気軽に学び始めることができます。

信頼の実績多数！
・日本最大級のプログラミングスクール実績
・受講者総数700名以上
・SaaS型学習サービス会員65,000名以上
・企業導入実績120社以上
・グッドデザイン賞受賞
・著名な賞受賞歴や経団連加盟も実現

夢を叶えるための第一歩を、一緒に踏み出しませんか？今なら、あなたもその一員として学び始めることができます！