MENU
  1. ホーム
  2. ExcelVBA
  3. ExcelVBAで連番と罫線の設定を1つのForループで同時に行う方法

ExcelVBAで連番と罫線の設定を1つのForループで同時に行う方法

広告
ExcelVBA

Excel VBAを使って、データに連番を振りながら特定の条件に応じて罫線を引く方法です。

複数のループを使う方法もありますが、VBAの強力な機能を活用すれば、1つのループで連番の設定と罫線の追加を同時に行うことができます。

目次

連番と罫線を振る例

実行前のデータです。

C列に1～3の連番を繰り返し振りつつ、値が「3」のセルに太い罫線を引く方法です。

実行後

サンプルコード

Sub sample2()
    Dim ws As Worksheet
    Dim i As Long
    Dim lastRow As Long
    Dim cNumber As Long
    
    ' シートを設定（"Sheet1" の場合）
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' A列の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 連番の初期値を設定（1からスタート）
    cNumber = 1
    
    ' C列の2行目から最終行までループ
    For i = 2 To lastRow
        ' C列に1～3の連番を振る
        ws.Cells(i, 3).Value = cNumber
        
        ' 連番が「3」の場合に青の太い罫線を引く
        If cNumber = 3 Then
            ' A～C列のセルの下罫線を太くする設定
           With Range(Cells(i, 1), Cells(i, 3)).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .Color = vbBlue
             End With 
        End If
        
        ' 連番の値を更新
        cNumber = cNumber + 1
        
        ' 連番が「3」を超えた場合に1にリセット
        If cNumber > 3 Then
            cNumber = 1
        End If
    Next i
End Sub

連番と罫線を振る例その2

連番は「1」からスタートし、3個ごとに次の数字に変わります。

サンプルコード

Sub sample3()
    Dim ws As Worksheet
    Dim i As Long
    Dim lastRow As Long
    Dim cNumber As Long
    Dim count As Long
    Dim interval As Long
    Dim lineInterval As Long

    ' 現在のシートを設定（"Sheet1" の場合）
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' A列の最終行を取得
    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row

    ' 連番の初期値とカウントの初期化
    cNumber = 1
    count = 0
    interval = 3 ' 各連番を3個ずつ入力
    lineInterval = interval 

    ' C列の2行目から最終行までループ
    For i = 2 To lastRow
        ' C列に連番を振る
        ws.Cells(i, 3).Value = cNumber
        
        ' 連番の個数をカウント
        count = count + 1
        
        ' 3個ごとに連番を変更
        If count >= interval Then
            count = 0
            cNumber = cNumber + 1
        End If
        
        ' 3個ごとに罫線を引く
        If (i - 1) Mod lineInterval = 0 And i > 2 Then
            ' 上罫線を引く設定
            With Range(Cells(i, 1), Cells(i, 3)).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .Color = vbBlue
             End With
        End If
    Next i
End Sub
ExcelVBA

関連記事

目次