作成日:  (更新日: )

Excel VBA のスニペット集

このページは、Excel VBA のスニペットなどをまとめる予定のページです。

目次

注意

  • コードのライセンスは CC0 (クレジット表示不要、改変可、商用可) です。

スニペット

Continue

Dim sheet As Worksheet
For Each sheet In Worksheets
    If sheet.Name = "Sheet1" Then
        GoTo Continue ' continue
    End If

    ' なにかする

Continue:
Next
  • VBA には言語機能としての continue がないためラベルと GoTo を使用します。

Break

Dim sheet As Worksheet
For Each sheet In Worksheets
    If sheet.Name = "Sheet1" Then
        Exit For ' Sheet1 が見つかったら抜ける
    End If
Next

Dim i As Integer
Do While i < 3
    If i = 1 Then
        Exit Do ' i が 1 だったら抜ける
    End If
    i = i + 1
Loop
  • VBA で break にあたるものは Exit For, Exit Do などです。

メッセージボックスの表示

MsgBox "Test"

入力用ダイアログボックスの表示

Dim s As String
s = InputBox("...を入力してください。", "タイトル", "初期値")

セル (Range オブジェクト) の取得

Dim r As Range
Set r = Range("A1") ' 番地を指定

Dim r As Range
Set r = Cells(1, 1) ' 行 (1から), 列 (1から) を指定。Cells(1, 1) は Range("A1") と同じ
  • Range() や Cells() は Application.ActiveSheet.Range() や Application.ActiveSheet.Cells() と同等です。

セルの値の取得

セルの内部値を取得
x = Range("A1").Value
書式化されたテキストを取得
x = Range("A1").Text

セルの値のセット

Range("A1").Value = 100

セルのコピー・貼り付け

書式含めすべて貼り付け
Range("A1").Copy
Range("B2").PasteSpecial
書式含めすべて貼り付け (クリップボードを経由しない)
Range("A1").Copy(Range("B2"))

セルの色付け

Range("A1").Interior.ColorIndex = 6 ' 色番号 (6 = 黄色)

Range("A1").Interior.Color = RGB(255, 255, 0) ' RGB (0～255)

列幅の自動調整

A列を自動調整
Columns("A").AutoFit
A～E列を自動調整
Columns("A:E").AutoFit
  • Columns() は Application.ActiveSheet.Columns() と同等です。

値が入っている最大行数を取得

Dim rowCount As Long
rowCount = Cells(mei.rows.Count, 1).End(xlUp).Row ' 1列目のセルのうち、値が入っているセルの最後の行数

行の削除

1行目を削除
Rows(1).Delete
  • Rows() は Application.ActiveSheet.Rows() と同等です。

ワークシートの追加

Dim sheet As Worksheet
Set sheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
sheet.Name = "シート名"

ワークシートの削除

Worksheets("シート名").Delete
削除確認ダイアログを抑える
Application.DisplayAlerts = False
Worksheets("シート名").Delete
Application.DisplayAlerts = True

入力ファイル選択ダイアログ (ファイルパスを取得)

' 例: テキストファイル選択
Dim path As String
path = Application.GetOpenFilename("テキストファイル(*.txt),*.txt")

' ファイルが選択されなかった場合 "False" になります。
If path = "False" Then
    ' Exit Sub など
End If

出力ファイル選択ダイアログ (ファイルパスを取得)

' 例: テキストファイル選択
Dim path As String
path = "test.txt"
path = Application.GetSaveAsFilename( _
     InitialFileName:=path _
   , FileFilter:="テキストファイル(*.txt),*.txt" _
   , FilterIndex:=1 _
   , Title:="保存先を指定して下さい。" _
   )

' ファイルが選択されなかった場合 "False" になります。
If path = "False" Then
    ' Exit Sub など
End If

フォルダ選択ダイアログ

Dim path As String
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = True Then
        path = .SelectedItems(1)
    End If
End With

ファイルの存在チェック

Dim path As String
path = "C:\test.txt"
If Dir(path) <> "" Then
    ' ファイルあり
End If

実行フォルダの取得

Dim path As String
path = ThisWorkbook.Path

印刷

プレビューなし
Call Worksheets("シート名").PrintOut
プレビューあり
Call Worksheets("シート名").PrintOut(Preview:=True)

テーブルの行を走査する

Dim o As ListObject
Set o = Worksheets("シート名").ListObjects("テーブル1")

For i = 1 To o.ListRows.Count
    ' MsgBox o.ListRows(i).Range(o.ListColumns("列名1").Index).Text ' 「列名1」の値を表示
    ' MsgBox o.ListRows(i).Range(2).Text ' 2列目の値を表示
Next

ディクショナリを使用する

ディクショナリ生成
Dim dict As Variant
Set dict = CreateObject("Scripting.Dictionary")
キーがあるか確認
If Not dict.Exists("key1") Then

End If
項目の追加
dict.Add "key1", "value1"
値の取得
x = dict("key1")

処理中の描画を抑える

Application.ScreenUpdating = False

' なにか処理

Application.ScreenUpdating = True
  • 描画を抑えると処理速度が向上します。

確認ダイアログを抑える

Application.DisplayAlerts = False

' なにか処理

Application.DisplayAlerts = True
  • 削除や保存確認ダイアログが出ないようになります。

文字変換

半角→全角
s = StrConv("ｱｲｳ", vbWide) ' → アイウ
全角→半角
s = StrConv("アイウ", vbNarrow) ' → ｱｲｳ
YYYYMMDD → 日付型
Dim d As Date
d = CDate(Format("20190101", "@@@@/@@/@@"))

CSV 読み込み

クエリテーブルを使用してCSVを読み込む
Dim sheet As Worksheet
Set sheet = Worksheets("Sheet1") ' 読み込み先のシート

Dim path As String
path = "C:\tmp\test.csv" ' CSVファイルの場所

With sheet.QueryTables.Add(Connection:="text;" & path, Destination:=sheet.Range("A1"))
    .Name = "link1"
    .TextFileCommaDelimiter = True
    .TextFilePlatform = 932
    .Refresh
    .Delete
End With

すべてのシートで A1 を選択

Module1
Sub SetA1()
    Dim sheet As Worksheet
    For Each sheet In Worksheets
        sheet.Select
        sheet.Range("A1").Select ' ワークシートの A1 を選択
    Next
    Sheets(1).Select ' 最初のシート (グラフシートなども含めて最初のシート) を選択
End Sub
ThisWorkbook (メニューコマンドで利用する場合)
Const MENU_ITEM_NAME = "セル選択をA1にセット"

Private Sub Workbook_Open() ' ブックが開かれる時
    With Application.CommandBars("Worksheet Menu Bar") ' メニューコマンド領域
        On Error Resume Next
        .Controls(MENU_ITEM_NAME).Delete ' メニュー項目追加
        On Error GoTo 0

        With .Controls.Add(Type:=msoControlButton, before:=.Controls.Count, temporary:=True)
            .Caption = MENU_ITEM_NAME ' メニュー名
            .OnAction = "SetA1" ' 実行する関数
            .Style = msoButtonIconAndCaption ' ボタンの外観 (https://docs.microsoft.com/ja-jp/office/vba/api/office.msobuttonstyle)
            .FaceId = 442 ' ボタンのアイコン (https://www.microsoft.com/en-us/download/details.aspx?id=50745)
        End With
   End With
End Sub

Private Sub Workbook_BeforeClose() ' ブックが閉じられる時
   With Application.CommandBars("Worksheet Menu Bar")
      On Error Resume Next
      .Controls(MENU_ITEM_NAME).Delete ' メニュー削除
      On Error GoTo 0
   End With
End Sub
ThisWorkbook (アドインとしてメニューコマンドで利用する場合)
Const MENU_ITEM_NAME = "セル選択をA1にセット"

Private Sub Workbook_AddinInstall() ' アドインのインストール時
    With Application.CommandBars("Worksheet Menu Bar") ' メニューコマンド領域
        On Error Resume Next
        .Controls(MENU_ITEM_NAME).Delete ' メニュー項目追加
        On Error GoTo 0

        With .Controls.Add(Type:=msoControlButton, before:=.Controls.Count, temporary:=True)
            .Caption = MENU_ITEM_NAME ' メニュー名
            .OnAction = "SetA1" ' 実行する関数
            .Style = msoButtonIconAndCaption ' ボタンの外観 (https://docs.microsoft.com/ja-jp/office/vba/api/office.msobuttonstyle)
            .FaceId = 442 ' ボタンのアイコン (https://www.microsoft.com/en-us/download/details.aspx?id=50745)
        End With
   End With
End Sub

Private Sub Workbook_AddinUninstall() ' アドインのアンインストール時
   With Application.CommandBars("Worksheet Menu Bar")
      On Error Resume Next
      .Controls(MENU_ITEM_NAME).Delete ' メニュー削除
      On Error GoTo 0
   End With
End Sub

PowerShell 実行

Dim path As String
path = "test.ps1"

Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
Dim command As String
command = "powershell -NoLogo -ExecutionPolicy RemoteSigned -File """ & path & """"
wsh.Run command, 1, True

ユーティリティ関数

ワークシートの存在確認

''' 指定した名前のワークシートがあるか確認します。
''' @param sheetName シート名
''' @return Boolean
Function Worksheet_Exists(ByVal sheetName As String) As Boolean
    Dim sheet As Worksheet
    For Each sheet In Worksheets
        If sheet.Name = sheetName Then
            Worksheet_Exists = True
            Exit Function
        End If
    Next
    Worksheet_Exists = False
End Function

ファイル保存 (UTF-8 BOMなし)

''' ファイルをUTF-8 BOM なしで保存します。
''' 参考: http://d.hatena.ne.jp/replication/20091117/1258418243
''' @param path 保存先のパス
''' @param contents ファイルの内容
Sub File_WriteAllTextUTF8WithoutBOM(ByVal path As String, ByVal contents As String)
    Dim binary As Variant

    With CreateObject("ADODB.Stream")
        .Type = 2 ' adTypeText
        .Charset = "UTF-8"
        .Open
        .WriteText contents
        
        ' バイナリで読み直す
        .Position = 0
        .Type = 1 ' adTypeBinary
        .Position = 3 ' BOM(3バイト)スキップ
        binary = .Read()
        .Close
    End With
    
    With CreateObject("ADODB.Stream")
        .Type = 1 ' adTypeBinary
        .Open
        .Write binary
        .SaveToFile path, 2 ' adSaveCreateOverWrite
        .Close
    End With
End Sub

文字列の組み立て

''' .NET の String.Format() のような形で簡易的に文字列を組み立てます。(例 String_Format("{0} {1}!", "Hello", 1234))
''' @param format 書式文字列
''' @param args() 挿入するデータ
''' @return String
Function String_Format(ByVal format As String, ParamArray args() As Variant) As String
    String_Format = format
    For i = 0 To UBound(args)
        String_Format = Replace(String_Format, "{" & i & "}", CStr(args(i)))
    Next
End Function