前稿のExcelの整形マクロを備忘のため貼り付けておきます。

Option Explicit

Sub SampleMacro_PMHF_Align()

    Dim ws As Worksheet
    Set ws = ActiveSheet

    '--- (1)～(5) の略: A6:A200 数値化, B列削除, B5:B200 & C5:C200 数値化, グリッド線オフ ---
    With ws.Range("A6:A200")
        .NumberFormat = "General"
        .Value = .Value
    End With
    
    ws.Columns("B").Delete
    
    With ws.Range("B5:B200")
        .NumberFormat = "General"
        .Value = .Value
    End With
    
    With ws.Range("C5:C200")
        .NumberFormat = "General"
        .Value = .Value
    End With
    
    ActiveWindow.DisplayGridlines = False

    '--- (6)～(7) 見出し行 A4:F4 / A5:F5 ---
    With ws.Range("A4:F4")
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Interior.ColorIndex = 15
        .HorizontalAlignment = xlCenter
    End With
    ws.Range("F4").Value = "PMHF[FIT]"

    With ws.Range("A5:F5")
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlThin
        ' この行の揃えは、あとでまとめて右詰/左詰にしてもOK
    End With

    '--- A列が "Total" or 数値 → F列に =B列/1E5*1E9 ---
    Dim r As Long, valA As Variant
    For r = 5 To 200
        valA = ws.Range("A" & r).Value
        If LCase(valA) = "total" Or (IsNumeric(valA) And Not IsEmpty(valA)) Then
            ws.Range("F" & r).Formula = "=B" & r & "/1E5*1E9"
            ws.Range("F" & r).NumberFormat = "0.0"
        End If
    Next r

    '--- (8)～(10) グループごとに "外枠のみ" 罫線 ---
    Dim i As Long, j As Long
    Dim dataA As Variant, dataD As Variant
    Dim foundRow As Long
    
    i = 6
    Do While True
        dataA = ws.Range("A" & i).Value
        dataD = ws.Range("D" & i).Value
        
        If (IsEmpty(dataA) Or dataA = "") And (IsEmpty(dataD) Or dataD = "") Then
            Exit Do
        End If
        
        foundRow = 0
        For j = i + 1 To 10000
            Dim tmpA As Variant, tmpD As Variant
            tmpA = ws.Range("A" & j).Value
            tmpD = ws.Range("D" & j).Value
            
            If (IsEmpty(tmpA) Or tmpA = "") And (IsEmpty(tmpD) Or tmpD = "") Then
                foundRow = j
                Exit For
            End If
            If (IsNumeric(tmpA) And Not IsEmpty(tmpA)) Or (IsEmpty(tmpD) Or tmpD = "") Then
                foundRow = j
                Exit For
            End If
        Next j
        
        If foundRow = 0 Then
            Exit Do
        End If
        
        ' グループ外枠だけ
        Call SetOuterBorders(ws.Range(ws.Cells(i, "A"), ws.Cells(foundRow - 1, "F")))
        
        i = foundRow
    Loop

    '--- (11)～(15) 相当: A6:F200 に最終的な罫線 ---
    ' 1) 外枠だけ
    Call SetOuterBorders(ws.Range("A6:F200"))
    ' 2) 縦の内側線 (これで列間が区切られ、縦のケイが表示される)
    Call SetInsideVerticalBorders(ws.Range("A6:F200"))
    ' ※ 横線は付けない → "横のケイ" は入らない

    '--- D1結合対策(任意) ---
    ws.Range("D1").MergeArea.ClearContents
    With ws.Range("A1:E1")
        .Merge
        .HorizontalAlignment = xlLeft
    End With

    '--- 列のオートフィット ---
    ws.Range("A4:F200").Columns.AutoFit

    '--- 行のオートフィットは不要なら省略 ---
    ' ws.Rows(1).AutoFit

    '--- A,B,C,F=右詰 / D,E=左詰 (5行目～200行目) ---
    With ws.Range("A5:A200"): .HorizontalAlignment = xlRight: End With
    With ws.Range("B5:B200"): .HorizontalAlignment = xlRight: End With
    With ws.Range("C5:C200"): .HorizontalAlignment = xlRight: End With
    With ws.Range("D5:D200"): .HorizontalAlignment = xlLeft:  End With
    With ws.Range("E5:E200"): .HorizontalAlignment = xlLeft:  End With
    With ws.Range("F5:F200"): .HorizontalAlignment = xlRight: End With

End Sub

'--- 外枠だけ ---
Private Sub SetOuterBorders(rng As Range)
    With rng
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With
End Sub

'--- 縦の内側線だけ ---
Private Sub SetInsideVerticalBorders(rng As Range)
    With rng.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End Sub

ChatGPT の回答は必ずしも正しいとは限りません。重要な情報は確認するようにしてください。

なお、本稿はRAMS 2028に投稿予定のため一部を秘匿していますが、論文公開後の2028年2月頃に開示予定です。

前のブログ 次のブログ