Excel VBA Codes

日々の業務でよく使いそうなExcelVBAのコードスニペットをまとめています。逆引きレファレンスというよりは、ユースケースライクな単位での記述をしていきます。

「表紙」シートのA1を選択してページ設定を横１に設定する

With ActiveWorkbook.Sheets("表紙")
    .Select                             'シート選択
    .PageSetup.Zoom = False             'ズームなし
    .PageSetup.FitToPagesWide = 1       '横1 ×縦なし
    .PageSetup.FitToPagesTall = False
    .Cells(1, 1).Activate               'A1セルを選択(シート選択を先にしておく)
End With

「テストケース」を含むシートの列幅、行タイトル、印刷品質を設定する

Dim sheet As Worksheet

For Each sheet In ActiveWorkbook.Sheets
    Call sheet.Select 
    'シート名にテストケースを含むか？
    If InStr(1, sheet.Name, "テストケース") > 0 Then
        'AからZ列までの列幅を12へ設定
        sheet.Range("A:Z").Columns.ColumnWidth = 12
        'ページ設定の行タイトルを$1:$10へ設定
        sheet.PageSetup.PrintTitleRows = "$1:$10"
        '印刷品質を300dpiへ設定
        sheet.PageSetup.PrintQuality = 300
    End If
Next
'最後に「表紙」シートを選択
Call ActiveWorkbook.Sheets("表紙").Select

A1からB1のセルを結合して、縮小して全体を表示する

With ActiveSheet.Range("A1:E1")
    .MergeCells = True   'セルを結合する
    .ShrinkToFit = True  '縮小して全体を表示する
End With

すべてのデータソースリンクを削除する

Dim links As Variant
Dim link As Variant

links = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(links) Then 'リンクがない場合はNothingとなるためチェック要
    For Each link In links
        Call ActiveWorkbook.BreakLink(link, xlLinkTypeExcelLinks)
    Next
End If

正規表現を利用する

Dim re As Object

Set re = CreateObject("VBScript.RegExp")
With re
    'マッチするか
    .Pattern = "\d+_\d+\ .*"
    Debug.Print .test("1_1 テストケース1") '->True
    Debug.Print .test("1-1 テストケース1") '->False
    
    '置換
    .Pattern = "(テストケース)(\d+)"
    Debug.Print .Replace("1-1 テストケース1", "TestCase$2") '->1-1 TestCase1
End With

Excel2007以降とそれより前でブック保存処理を分岐する

If Val(Application.Version) < 12 Then
    'Excel2003以下
    ActiveWorkbook.SaveAs fileName:=fileName
    ActiveWorkbook.Close SaveChanges:=False
Else
    'Excel2007以降
    ActiveWorkbook.SaveAs fileName:=fileName, FileFormat:=56
    ActiveWorkbook.Close SaveChanges:=False
End If

1行目が特定の値の場合に、その列を複数選択する

Dim i As Integer
Dim colRange As range
Dim ws As Worksheet

Set ws = ActiveSheet

With ws
    For i = 1 To .UsedRange.End(xlToRight).Column
        With .Cells(1, i)
            '1行目の値がhogeの場合
            If .Value = "hoge" Then
                If colRange Is Nothing Then
                    Set colRange = .EntireColumn
                Else
                    Set colRange = Union(colRange, .EntireColumn)
                End If
            End If
        End With
    Next
    
    If Not colRange Is Nothing Then
        '複数列を選択
        Call colRange.Select
    End If
End With