この記事は何
Excelマクロ(VBAコード)のサンプル集です。
VBAのコーディングに時間を割くのは勿体ないので、よく使うであろうコードをまとめました。
2025/10/30追記
基本編
メッセージを表示する (MsgBox)
備考：第2引数は「+」で追加して連結する
Sub Message()
MsgBox "Hello World!", vbInformation, "タイトル"
MsgBox "警告アイコン", vbCritical '値：16
MsgBox "問い合わせアイコン", vbQuestion '値：32
MsgBox "注意アイコン", vbExclamation '値：48
MsgBox "情報アイコン", vbInformation '値：64
'MsgBoxの戻り値で分岐 (If文)
If MsgBox("良いですか？", vbOKCancel + vbQuestion, "確認1") = vbCancel Then
MsgBox "「Cancel」が押されました。"
Exit Sub
End If
'MsgBoxの戻り値で分岐 (Select Case文)
Select Case MsgBox("どうしますか？", vbYesNo + vbQuestion + vbDefaultButton2, "確認2")
Case vbYes
MsgBox "「はい」が押されました。"
Case vbNo
MsgBox "「いいえ」が押されました。"
End Select
End Sub
※「'値：16」とかの意味は下の方で解説している「参照設定について」の項目を読むとわかるかも。
ログ出力 (Debug.Print)
イミディエイトウィンドウ内に出力されるため、イミディエイトウィンドウを表示する設定にしておく。
Debug.Print "ログだよ～(o・∇・o)"
最終行・最終列の取得
'最終行・最終列の取得
Dim End_Row As Long, End_Col As Long
End_Row = Cells(Rows.Count, 2).End(xlUp).Row '最終行（2列目）
End_Col = Cells(3, Columns.Count).End(xlToLeft).Column '最終列（3行目）
格納する変数はInteger型にしてしまうと32,767行以上でオーバーフローするので注意！
書式設定
'セルの結合
Range(Cells(1, 1), Cells(2, 1)).Merge '縦2セル
Range(Cells(3, 1), Cells(3, 3)).Merge '横3セル
'表示形式
With Range(Cells(7, 7), Cells(12, 7)) '指定範囲
.NumberFormatLocal = "@" 'テキスト型
.WrapText = False 'テキスト折り返し
.VerticalAlignment = xlTop '垂直位置 上詰め
.HorizontalAlignment = xlGeneral '水平位置 標準
End With
With Range(Cells(8, 8), Cells(13, 8))
.NumberFormatLocal = "yyyy/mm/dd" '日付 / 時刻型
.VerticalAlignment = xlCenter '垂直位置 中央揃え
.HorizontalAlignment = xlLeft '水平位置 左詰め
End With
With Range(Cells(5, 5), Cells(10, 5))
.NumberFormatLocal = "#,##0_ ;[赤]-#,##0_ " '数値型(マイナス：不等号・赤文字)
.VerticalAlignment = xlBottom '垂直位置 下詰め
.HorizontalAlignment = xlRight '水平位置 右詰め
End With
With Range(Cells(6, 6), Cells(11, 6))
.NumberFormatLocal = "0.0%" 'パーセント(小数第1位まで)
.VerticalAlignment = xlDistributed '垂直位置 均等割り付け
.HorizontalAlignment = xlCenter '水平位置 中央揃え
End With
'背景色の設定
With .Cells(15, 15)
'Excel定数
.Interior.Color = vbYellow 'セル背景色：黄色
.Font.Color = vbRed '文字色：赤
'RGB関数
.Interior.Color = RGB(171, 219, 227) 'セル背景色：ターコイズ
.Font.Color = RGB(204, 255, 204) '文字色：緑
End With
'グラデーション設定
With Range(Cells(1, 1), Cells(1, 3)).Interior 'Range内の背景色
.Pattern = xlPatternLinearGradient
With .Gradient
.Degree = 90 'グラデーションの角度(0～360°)
With .ColorStops 'グラデーションの切替ポイントの設定
.Clear '最初に初期化
'グラデーションの切替ポイント(0～1)を追加して色を設定
.Add(0).Color = RGB(255, 255, 255)
.Add(1).Color = RGB(255, 153, 204)
End With
End With
End With
'行の高さ
Rows("1:3").RowHeight = 15 '1～3行目 高さ15
'列の幅
Range(Columns(3), Columns(5)).ColumnWidth = 12 '3～5列目 幅12
ハイパーリンクの設定
With ThisWorkbook.Worksheets(1)
.Hyperlinks.Add Anchor:=.Cells(10, 4), _
Address:="https://www.yahoo.co.jp/"
End With
ウィンドウ枠の固定
With ThisWorkbook.Worksheets(1)
.Activate
.Range("B3").Select
ActiveWindow.FreezePanes = True
End With
Select Case文
意外と記法を忘れやすい。
Const ABC = "momo"
Select Case ABC
Case "momo"
MsgBox "pink"
Case "sora"
MsgBox "blue"
Case "shiina"
MsgBox "yellow"
Case Else
MsgBox "other"
End Select
文字を入力させる（InputBox）
初期値あり、キャンセルボタン処理も対応
Sub Input01()
Dim ans As String ' InputBoxの戻り
Dim flg As Boolean: flg = False
Do
ans = InputBox(Prompt:="入力してください。", Default:="初期値")
If StrPtr(ans) = 0 Then Exit Sub ' キャンセル時に終了
If ans <> "" Then flg = True '空白でなければループ抜ける
Loop Until flg = True
MsgBox ans
End Sub
よく使う文の組み合わせ
新規ブックを作成し、各種書式設定を行う
Sub Example()
Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks.Add '新規ブック作成
Set ws = wb.Worksheets(1) '1シート目を指定
'-------------------------------------------------------------------
With ws
.Name = "シート名"
Columns(1).ColumnWidth = 6 '1列目の列幅6
'-------------------------------------------------------------------
'ヘッダー作成
ReDim HeaderArr(3)
HeaderArr(0) = "No."
HeaderArr(1) = "Name"
HeaderArr(2) = "Date"
HeaderArr(3) = "Label"
With Range(.Cells(1, 1), .Cells(1, 4))
.Value = HeaderArr 'ヘッダーの配列を範囲に貼り付け
.Interior.Color = RGB(197, 217, 241)
.Borders.LineStyle = 1 '罫線種類
.Borders.Weight = 2 '罫線太さ
.HorizontalAlignment = xlCenter
.AutoFilter 'オートフィルター
End With
'-------------------------------------------------------------------
'行番号を振る
Dim i As Long 'Integerだと32,767行超える時にオーバーフローするのでLong推奨
Dim LineNo() As String
ReDim LineNo(1 To 20, 1 To 1)
For i = 1 To 20
LineNo(i, 1) = i
Next i
With Range(.Cells(2, 1), .Cells(UBound(LineNo) + 1, 1))
.Value = LineNo '配列をバッと貼る
.Interior.Color = vbYellow '背景色
End With
'-------------------------------------------------------------------
'罫線を引く
With .Range(.Cells(1, 1), .Cells(UBound(LineNo) + 1, 4))
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
'-------------------------------------------------------------------
'入力規則を設定（プルダウン選択リスト）
Dim items() As Variant
items = Array("ゆい,かおり") 'カンマ区切りだがダブルクォートは両端のみ
With Range(.Cells(2, 2), .Cells(21, 2)).Validation
.Delete '元の設定を削除
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(items, ",")
End With
'-------------------------------------------------------------------
.Columns("A:D").AutoFit '列幅自動調整
.Cells(1, 1).Activate 'A1を選択状態に
End With
'-------------------------------------------------------------------
End Sub
シートの存在チェック関数
シート名を引数で渡すと、そのシートがブック内に存在するか確認して結果をBooleanで返します。
' シートの存在チェック関数
Public Function SheetExists(SheetName As String) As Boolean
Dim ws As Worksheet
SheetExists = False
For Each ws In Worksheets
If ws.Name = SheetName Then
SheetExists = True
Exit For
End If
Next ws
End Function
ブックオープン時に自動実行
※標準モジュールに書く場合、他のブックからオープンされると実行されないので注意。
標準モジュール
Private Sub Auto_Open()
MsgBox "開かれました!（標準モジュール）"
End Sub
▼こちらは必ず実行される
ThisWorkbook
Private Sub Workbook_Open()
MsgBox "開かれました!（ThisWorkbook）"
End Sub
アドイン形式（.xlam）の自動実行について
VBA内でオートメーションで別プロセスのExcelを立ち上げた場合、xlamファイルのアドインは読み込まれない。Auto_Openも無効。
- Excel2010で新規Excelを立ち上げると、新プロセスとして起動（xlamのAuto_Openがここで実行される）
- Excel2013以降で新規Excelを立ち上げると、既存プロセスの別ブックとして起動（xlamのAuto_Openは実行されない）
描画停止で処理高速化
セルに変更を加える処理をループで回す場合に、描画を止めると早くなるという定石がある。
以下コード、時間計測のおまけ付き
Dim st As Double: st = Timer '時間計測開始
Application.ScreenUpdating = False '描画停止
Application.Calculation = xlCalculationManual '自動計算停止
'-------------------------------------------------------------------
'ここで時間のかかる処理
'-------------------------------------------------------------------
Application.Calculation = xlCalculationAutomatic '自動計算
Application.ScreenUpdating = True '描画再開
Debug.Print "処理時間 " & Round(Timer - st, 2) & " sec."
読み取り専用に変更
If ThisWorkbook.ReadOnly = False Then '現在の設定が読み取り専用でないかチェック
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly '読み取り専用に変更
End If
'逆に書き込みを許すとき↓
ThisWorkbook.ChangeFileAccess (xlReadWrite)
参照設定について
参照設定とは
VBAで外部ライブラリ（例：Excel、Access、ADOなど）の機能を利用する方法には、
事前バインディング（Early Binding） と 遅延バインディング（Late Binding） の2種類がある。
事前バインディング：
「ツール」→「参照設定」で必要なライブラリにチェックを付ける。
コード例
Dim obj As ADODB.Connection
Set obj = New ADODB.Connection
メリット
- コード補完（IntelliSense）が使える
- 定数名を直接使用できる
デメリット
- 各ブックごとに参照設定が必要
- ライブラリのバージョン違いでエラーになることがある
遅延バインディング：
CreateObject を使用するため、参照設定は不要。
コード例
Dim obj As Object
Set obj = CreateObject("ADODB.Connection")
メリット
- 参照設定が不要（ブック間で共有しやすい）
- バージョンの違いによるエラーが起きにくい
デメリット
- 定数補完が効かないため数値を直接指定する必要がある
- 型情報を利用できない
例：
' 事前バインディング（参照設定あり）
obj.Open , , , adOpenKeyset ' 定数名が使用可能
' 遅延バインディング（参照設定なし）
obj.Open , , , 1 ' 定数値を直接指定
参照設定まとめ
| 事前バインディング | 遅延バインディング | |
|---|---|---|
| 設定方法 | 「ツール」→「参照設定」でライブラリにチェック | CreateObjectを使用 |
| メリット | コード補完・定数使用が可能 | 参照設定不要で手軽 |
| デメリット | ブックごとに設定が必要 | 定数補完なし・型宣言不可 |
ファイル操作 (FileSystemObject)
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'ファイルコピー
FSO.CopyFile "コピー元パス", "コピー先パス", True '第3引数Trueで上書きコピー
'ファイル移動
FSO.MoveFile "移動元パス", "移動先パス"
'移動先にすでに同名ファイルが存在する場合はエラー
'移動元ファイルは読み取り専用でも移動される
' ファイル削除
FSO.DeleteFile "ファイルパス", True
'引数forceは省略可。Trueを指定すると読み取り専用ファイルも削除される。
' ファイル存在確認
If FSO.FileExists("ファイルパス") Then
Debug.Print "あるよ"
End If
Debug.Print FSO.GetParentFolderName("ファイルパス") '親フォルダのパスを取得
Debug.Print FSO.GetFileName("ファイルパス") 'ファイル名と拡張子を取得
Debug.Print FSO.GetBaseName("ファイルパス") '拡張子なしファイル名を取得
Debug.Print FSO.GetExtensionName("ファイルパス") '拡張子のみを取得
'ファイル更新日時系
Dim f As Object
Set f = FSO.GetFile("ファイルパス") 'ファイルを取得
Debug.Print f.DateLastModified '更新日時を取得
Debug.Print f.DateCreated '作成日時を取得
Debug.Print f.DateLastAccessed 'アクセス日時を取得
Set FSO = Nothing
MoveFileは同名パスが既に存在するとエラーになるのでFileExistsと組み合わせるのを推奨
UTF-8のテキストファイルを読み込む
VBAはデフォルトではShift_JISしか読めないのでADODB.Streamを利用する。
Dim buf As String
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile "ファイルパス"
buf = .ReadText '全データがbufに入る
.Close
End With
HTTPリクエストで文字列を取得
取得した値はベタのHTMLなのでスクレイピング用途には加工が必要
Dim URL As String
URL = "http://abehiroshi.la.coocan.jp/"
Dim respText As String ' レスポンス
'-------------------------------------------------------------------
'HTTPリクエスト準備
Dim httpReq As Object ' MSXMLオブジェクト
Set httpReq = CreateObject("MSXML2.XMLHTTP") ' MSXMLオブジェクト生成
'-------------------------------------------------------------------
httpReq.Open "GET", URL, False ' False は同期処理
httpReq.send ' HTTPリクエストの送信
If httpReq.Status = 200 Then '200で正常取得
respText = httpReq.responseText
Debug.Print respText
Else
MsgBox "サーバー接続エラー" _
& vbCrLf & httpReq.Status & " " & httpReq.statusText, vbCritical, "タイトル"
Exit Function
End If
ADODBでSQL Serverに接続
参照設定する場合は ActiveX Data Objects 6.1 Library を有効化しておく
Sub DataBase_Sample()
'-------------------------------------------------------------------
'DB変数定義
Dim strSQL As String ' SQL文字列
Dim cn As Object ' コネクション
Dim rs As Object ' レコードセット
'-------------------------------------------------------------------
'接続設定
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
'ADOでSQLServerに接続
With cn
.Provider = "SQLOLEDB" 'OLE DBプロバイダ
.ConnectionTimeout = 180 '接続タイムアウト時間 (単位:秒)
.CommandTimeout = 120 'コマンドタイムアウト時間 (単位:秒)
.Properties("Data Source").Value = "サーバー名\インスタンス名"
.Properties("Initial Catalog").Value = "データベース名"
.Properties("User ID").Value = "user" 'アカウント
.Properties("Password").Value = "password" 'パスワード
' .Properties("Integrated Security").Value = "SSPI" 'Windows認証を使用する場合
.CursorLocation = 3 ' クライアントサイドカーソルに変更 → 3にしないとrs.RecordCountが正しく取れない
.Open
End With
'----------------------------------------------------------------------
'INSERT文
strSQL = "INSERT INTO [t_Log] ([UserID], [Message], [Status], [created_at])"
strSQL = strSQL & "VALUES ('625', 'mocho', 'Success', getDate())"
cn.Execute strSQL
'----------------------------------------------------------------------
'SELECT文 (登録・更新)
strSQL = "SELECT * FROM [TableName] "
strSQL = strSQL & "WHERE CAST([created_at] as Date) = '" & Format(Now, "yyyy-mm-dd") & "' "
strSQL = strSQL & "OR [name] = 'Momo' "
'レコードセットを開く
'rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic, 1 '参照設定ありの場合、定数が使用可能
rs.Open strSQL, cn, 1, 3, 1
'カーソルタイプ '0:adOpenForwardOnly '1:adOpenKeyset 2:adOpenDynamic 3:adOpenStatic
'ロックタイプ '1:adLockReadOnly 2:adLockPessimistic 3:adLockOptimistic 4:adLockBatchOptimistic
'オプション '1:adCmdText
'----------------------------------------------------------------------
Debug.Print rs.RecordCount
If rs.EOF Then
'新規登録
rs.AddNew
rs![name] = "Momo"
rs![prefecture] = "Fukuoka"
rs![food] = "Udon"
rs![created_at] = Now
rs![updated_at] = Now
rs.Update
Else
'更新
rs![food] = "Chili Tomato"
rs![updated_at] = Now
rs.Update
End If
'----------------------------------------------------------------------
rs.Close
Set rs = Nothing
End Sub
ADODBでOracle Databaseに接続
事前にOracle Clientをインストールしておく必要がある。
Oracleへの接続情報の設定については、以下の2種類がある。
TNSサービス名で接続する場合（tnsnames.oraに記載する方法）
- 「C:\app\client[user_name]\product\12.1.0\client_1\network\admin」に移動
（Oracle DBのバージョンによってパスが変わる） - 「sqlnet.ora」をコピーし、名前を「tnsnames.ora」に変更
- 「tnsnames.ora」を開き以下の部分を削除
tnsnames.ora
# This file is actually generated by netca. But if customers choose to
# install "Software Only", this file wont exist and without the native
# authentication, they will not be able to connect to the database on NT.
SQLNET.AUTHENTICATION_SERVICES= (NTS)
NAMES.DIRECTORY_PATH= (TNSNAMES, EZCONNECT)
4. 「tnsnames.ora」の下部に以下のように接続先情報を追記
tnsnames.ora
＜ネットサービス名＞ =
(DESCRIPTION =
(ADDRESS = (PROTOCOL = TCP)(HOST = localhost)(PORT = 1521))
(CONNECT_DATA =
(SERVER = DEDICATED)
(SERVICE_NAME = <サービス名>)
)
)
こちらの記事を参考にしました。
https://xakamsi.hatenablog.com/entry/2019/02/18/190953
VBAソース側
'------------------------------------------------
'接続情報
Private Const PROVIDER As String = "OraOLEDB.Oracle"
Private Const DATA_SOURCE As String = "orcl" 'ネットサービス名
'------------------------------------------------
'アカウント情報
Private Const USER_ID As String = "user" 'データベースのユーザID
Private Const PASSWORD As String = "password" 'データベースのパスワード
'------------------------------------------------
Dim cn As Object
Dim rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
'------------------------------------------------
'データベース接続
cn.ConnectionString = "Provider=" & PROVIDER _
& ";Data Source=" & DATA_SOURCE _
& ";User ID=" & USER_ID _
& ";PASSWORD=" & PASSWORD
cn.Open
'------------------------------------------------
TNSサービス名を使用せず直接接続する（ソースコード内に接続情報を記載）
VBAソース側
'------------------------------------------------
'接続情報
Private Const HOST_NAME As String = "localhost" 'データベースのホスト名orIPアドレス
Private Const PORT_NO As String = "1521" 'データベースのポート番号
Private Const SERVICE_NAME As String = "orcl" 'サービス名
'------------------------------------------------
'アカウント情報
Private Const USER_ID As String = "user" 'データベースのユーザID
Private Const PASSWORD As String = "password" 'データベースのパスワード
'------------------------------------------------
Dim cn As Object
Dim rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
'------------------------------------------------
'データベース接続
cn.ConnectionString = "Provider=" & PROVIDER _
& ";Data Source=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)" _
& "(HOST=" & HOST_NAME & ")" _
& "(PORT=" & PORT_NO & "))" _
& "(CONNECT_DATA=" _
& "(SERVICE_NAME=" & SERVICE_NAME & ")))" _
& ";User ID=" & USER_ID _
& ";PASSWORD=" & PASSWORD
cn.Open
'------------------------------------------------
Oracleは何かとエラーが出やすいので、上手く接続できないときはORA番号で根気強くググってください...
AIに聞くと解決が早いかもしれません。
おわりに
何か文句や間違いがあればコメントで教えてください。
（コピペプログラマなのでお手柔らかにお願いします...）