Excel VBA｜コード備忘録 コピペ用
よく使うExcelのVBAコードと注意点をまとめてみた。
随時更新予定。
基本
・最終行、最終列の取得
Dim LastRow as Long
Dim LastCol as Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row '１列目の最終行
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column '１行目の最終列Integer型で定義するとオーバーフローするのでLong型にする。
・セルのクリア
Range("C5:M23").ClearContents 'C5からM23の範囲のセルのデータのみクリア
Range(Cells(1,1),Cells(3,5)).ClearContents '指定の範囲のデータのみクリア
Cells.ClearContents 'シート全体のデータのみクリア
Range("C5:M23").Clear 'すべてクリア
Range("C5:M23").ClearFormats 'フォーマットのみクリア
Range("C5:M23").ClearNotes 'コメントやメモをクリア
Range("C5:M23").ClearHyperlinks 'ハイパーリンクをクリア
Range("C5:M23").ClearOutline 'アウトライン（グループ化）をクリア・セルのコピー
'コピペ
Range(“A1”).Copy Range(“C5”)
'値のみコピペ
Range(“A1”).Copy
Range(“C5”).PasteSpecial xlPasteValues
Application.CutCopyMode = False '囲まれるコピー箇所を解除
'値のみコピペ 別バージョン
Range("C5").Value = Range("A1").ValueRange.PasteSpecial(Paste, Operation, SkipBlanks, Transpose)
Paste(省略可能)：何を貼り付けるかを指定
xlPasteAll（既定） すべて
xlPasteFormulas 数式
xlPasteValues 値
xlPasteFormats 書式
xlPasteComments コメント
xlPasteValidation 入力規則
xlPasteAllExceptBorders 罫線を除く全て
xlPasteColumnWidths 列幅
xlPasteFormulasAndNumberFormats 数式と数値の書式
xlPasteValuesAndNumberFormats 値と数値の書式
xlPasteAllUsingSourceTheme コピー元のテーマを使用しすべて貼り付け
xlPasteAllMergingConditionalFormats すべての結合されている条件付き書式
Operation(省略可能)：貼り付けの際の演算方法を指定
xlPasteSpecialOperationNone（既定）しない
xlPasteSpecialOperationAdd 加算
xlPasteSpecialOperationSubtract 減算
xlPasteSpecialOperationMultiply 乗算
xlPasteSpecialOperationDivide 除算
SkipBlanks(省略可能)：空白セルを無視(True)、無視しない(False：既定値)
Transpose(省略可能)：行列を入れ替える(True)、入れ替えない(False：既定値)
・シートのコピー、移動
'シートAを前（後）にコピー
Worksheets("シートA").Copy Before:=Worksheets("シートA") '前にコピー Afterにすると後ろにコピー
ActiveSheet.Name = "シートB" 'シート名変更
'シートAを先頭にコピー
Worksheets("シートA").Copy Before:=Worksheets(1)
'シートAを一番後ろにコピー
Worksheets("シートA").Copy After:=Worksheets(Worksheets.Count)
'複数シートをコピー
Worksheets(Array("シートA","シートB")).Copy Before:=Worksheets(1)
'シートAを一番後ろに移動
Worksheets("シートA").Move After:=Worksheets(Worksheets.Count)・シートの削除、クリア
'シートA削除
Worksheets("シートA").Delete
'シートAの中身全てをクリア
Worksheets("シートA").Cells.Clear
'シートAの書式をクリア
Worksheets("シートA").Cells.ClearFormats
'シートAの数値と値をクリア
Worksheets("シートA").Cells.ClearContents
'シートAのハイパーリンクをクリア
Worksheets("シートA").Cells.ClearHyperlinks・改行
'メッセージボックス内の改行
Msgbox "1行目" & vbCrLf & "2行目"
'エクセルのセル内の改行
Cells(1,1).Value = "上" & vbLf & "真ん中" & vbLf & "下"・高速化｜画面の更新を停止
Application.ScreenUpdating = False
'メインプログラム
Application.ScreenUpdating = True '最後に忘れずに戻す・警告メッセージの非表示
Application.DisplayAlerts = False 'メッセージを非表示
Application.DisplayAlerts = True 'メッセージを表示・メッセージボックスによる分岐選択
Dim rc as long
rc = MsgBox("メッセージ" & vbCrLf & "2行目メッセージ", vbYesNoCancel + vbQuestion, "タイトル")
If rc = vbYes Then
'「はい」時の処理
ElseIf rc = vbNo Then
'「いいえ」時の処理
Else
'「キャンセル」時の処理
End IfMsgBox (prompt, [buttons], [title], [helpfile], [context])
prompt：表示メッセージ
buttons(省略可)：選択ボタン「vbOKOnly, vbOKCancel, vbAbortRetryIgnore, vbYesNoCancel, vbYesNo, vbRetryCancel」
＋ アイコン「vbCritical, vbQuestion, vbExclamation, vbInformation」
＋ デフォルト「vbDefaultButton1, vbDefaultButton2, vbDefaultButton3, vbDefaultButton4」
title(省略可)：タイトルバーに表示する文字列
hepfile(省略可)：使わない
context(省略可)：使わない
・ファイル選択ダイアログ（ファイルを指定して開く）
Sub OpenFile() 'ファイルを指定して開く
Dim FileName As Variant
'ファイル選択ダイアログを表示 すべてのエクセルファイルを開く
FileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*,CSVファイル,*.csv")
'キャンセルの場合
If FileName = False Then
MsgBox "キャンセルされました"
Exit Sub
End If
'CSVファイルをopen
Workbooks.Open FileName
End SubApplication.GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)
FileFilter：ファイル候補を指定するための文字列 (ファイル フィルター文字列)
FilterIndex(省略可)：FileFilter の何番目を既定値とするか
Title(省略可)：ダイアログ ボックスのタイトル
ButtonText(省略可)：Macのみ指定できる
MultiSelect(省略可)：True で複数のファイルを選択、False（既定値）で1つのファイルのみ選択。
戻り値：Variant型。ファイルのフルパスが文字列で戻る。選択しなかった場合はFalseが戻る。
・検索してセル情報を取得（結果が1つ）
Dim ChkObj As Range
Dim ChkRange As Range
Dim ChkWord As String
Dim ChkCol As Long '検索した文字の列番号
Dim ChkRow As Long '検索した文字の行番号
Set ChkRange = Rows(1) '1列目を探す
Set ChkWord = "探すキーワード"
Set ChkObj = Worksheets("シートA").ChkRange.Find(ChkWord, LookAt:=xlWhole)
'もしデータがなかったら
If ChkObj Is Nothing Then
MsgBox "'" & ChkWord & "'はありませんでした"
Exit Sub
End If
ChkCol = ChkObj.Column
ChkRow = ChkObj.Row
End IfFind(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
What：検索するデータ
After(省略可)：検索開始セルを指定
LookIn(省略可)：検索対象種類
xlFormulas 数式
xlValues 値
xlComents コメント文
LookAt(省略可)：検索条件
xlPart 部分一致
xlWhole 完全一致
SearchOrder(省略可)：検索方向
xlByRows 列
xlByColumns 行
SearchDirection(省略可)：検索順番
xlNext 順方向(既定値)
xlPrevious 逆方向
MatchCase(省略可)：大文字と小文字を区別(True)、区別しない(False)(既定値)
MatchByte(省略可)：半角と全角を区別(True)、区別しない(False)(既定値)
戻り値：Range型、みつからない場合はNothing
findは処理速度が遅いため、以下の方法で検索するのも可
Dim chkObj As Range
'完全一致
Set chkObj = Cells(WorksheetFunction.Match("探すキーワード", Range("A:A"), 0), 1)
'部分一致
Set chkObj = Cells(WorksheetFunction.Match("*探すキーワード*", Range("A:A"), 0), 1)ワークシートの関数
＝MATCH（検索値、検索範囲、照合種類）
検索値：検索するデータ
検索範囲：検索する範囲
照合種類：照合の種類（0：完全一致、-1：以上、1：以下）
・検索してセル情報を取得（結果が複数）
'検索が１列の場合
Dim chkRng As Range '検索範囲
Dim i As Long
Dim chkAry As Variant '配列
Set chkRng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
chkAry = chkRng 'セル範囲を配列変換
For i = LBound(chkAry) To UBound(chkAry)
If chkAry(i, 1) Like "*キーワード*" Then
Cells(i, 1).Interior.Color = vbBlue
End If
Next
'検索が複数列の場合
Dim chkRng As Range '検索範囲
Dim i As Long
Dim t As Long
Dim chkAry As Variant '配列
Set chkRng = Range(Cells(1, 1), Cells(Rows.Count, 3).End(xlUp))
chkAry = chkRng 'セル範囲を配列変換
For t = LBound(chkAry, 2) To UBound(chkAry, 2) '列の下限から上限まで
For i = LBound(chkAry, 1) To UBound(chkAry, 1) '行の下限から上限まで
If chkAry(i, t) Like "*キーワード*" Then
Cells(i, t).Interior.Color = vbBlue
End If
Next
Next・エラー処理
'処理のスキップ------------------------------------
On Error GoTo Err1
'(エラーが発生し得る処理)
Exit Sub
Err1:
'(エラー発生時の処理)
'エラー発生箇所に戻り処理の継続 ループの場合のエラー処理はこれ--
On Error GoTo Err1
'(エラーが発生し得る処理)
Exit Sub
Err1:
'(エラー発生時の処理)
Resume Next
'エラーの種類で処理を変える----------------------
On Error GoTo ErrLabel
'(エラーが発生し得る処理)
Exit Sub
ErrLabel:
Select Case Err.Number
Case 9
MsgBox "インデックスが有効範囲にありません" & vbCrLf & Err.Description
Case 1004
MsgBox "実行できませんでした" & vbCrLf & Err.Description
Case Else
MsgBox "予期せぬエラーが発生しました" & vbCrLf & Err.Number & ":" & Err.Description
End Select
Resume NextErr.プロパティ
プロパティ一覧
Description：エラーの説明
HelpContext：ヘルプファイルのコンテキスト
IDHelpFile：ヘルプファイルへの絶対パス
LastDLLError：DLLの呼び出しにより作成されたエラーコード
Number：エラーを指定する値
Source：エラーを発生させたオブジェクト、アプリ名
エラー番号一覧（よく使いそうな番号を抜粋）
6：オーバーフローしました。
→ 変数の許容範囲を確認
9：インデックスが有効範囲にありません。
→ 存在しない配列要素を参照していないか確認
13：型が一致しません。
→ データ型の確認
76：パスが見つかりません。
→ 指定したパスが存在するか確認
91：オブジェクト変数または With ブロック変数が設定されていません。
→ 有効なオブジェクトを参照していないオブジェクト変数、もしくはNothing に設定されているオブジェクト変数を使用しようとしている。
94：Null の使い方が不正です。
→ Null 値のバリアント型変数の値を取得しようとしている
380：プロパティの値が不正です。
→ 不適切な値がプロパティに割り当てられている
424：オブジェクトが必要です。
→ オブジェクト修飾子が指定されていない
425：オブジェクトの使い方が不正です。
→ 適切な適用範囲外でオブジェクトを使用しようとしている
1004：アプリケーション定義またはオブジェクト定義のエラーです。
→ Visual Basic for Applications で定義されたエラーに対応しない場合に表示される
繰り返し・条件分岐処理
・Do〜Loop
'条件が真の間は処理を行う
Do While '条件
'処理
Loop
'条件が真になるまで処理を行う
Do Until '条件
'処理
Loop
'一度処理を実行した後、条件が真の間は処理を行う。
Do
'処理
Loop While '条件
'一度処理を実行した後、条件が真になるまで処理を行う
Do
'処理
Loop Until '条件・For〜Next
'1づつ加算
Dim i
For i = 1 To 20
Cells(i, 1).Value = i
Next
'Step分加算
Dim i
For i = 1 To 20 Step 2
Cells(i, 1).Value = i
Next・Select Case
'数字のパターン
Dim Num As Integer
Num = 5
Select Case Num
Case 1,2
'処理1
Case 3 To 5
'処理2
Case Is >= 6, Is < 10 '6以上10未満
'処理3
Case Else
'どの条件にも一致しなかった場合の処理
End Select
'文字列のパターン
Dim Str As Integer
Str = "1年生"
Select Case Str
Case "1年生"
'処理1
Case "2年生","3年生"
'処理2
Case Like "*年生" '*は任意の文字列、#は任意の数字、?は任意の1文字
'処理3
Case Else
'どの条件にも一致しなかった場合の処理
End Select複数の条件に当てはまる場合、最初に合致した条件に適応されるため注意！
ピボット関連
・ピボットテーブル作成、フィルター（統計用）
Sub PivCreate() 'ピボットテーブルの作成
Dim wsNameC As String 'csv等の元データのシート名
Dim wsNameP As String 'ピボット作成先のシート名
wsNameC = "データシート名"
wsNameP = "ピボットシート名"
'シートのクリア
ThisWorkbook.Worksheets(wsNameP).Cells.Clear
'元データ取得
Set dataRng = ThisWorkbook.Worksheets(wsNameC).Range("A1").CurrentRegion
'ピボット作成して名前設定（シートと同じ名前にした。A3を起点に作成）
ThisWorkbook.PivotCaches.Create(xlDatabase, dataRng).CreatePivotTable ThisWorkbook.Worksheets(wsNameP).Range("A3")
ThisWorkbook.Worksheets(wsNameP).PivotTables(ThisWorkbook.Worksheets(wsNameP).PivotTables.Count).Name = wsNameP
'フィールドの設定
With ThisWorkbook.Worksheets(wsNameP).PivotTables(wsNameP)
.PivotFields("フィールド1").Orientation = xlRowField '行フィールド設定
.PivotFields("フィールド2").Orientation = xlRowField '行フィールド設定
.PivotFields("フィールド3").Orientation = xlRowField '行フィールド設定
.PivotFields("フィールド4").Orientation = xlColumnField '列フィールド設定
.PivotFields("フィールド5").Orientation = xlPageField 'フィルターフィールド設定
.RowAxisLayout xlTabularRow 'この時点でピボット作成
'フィルターフィールド作成
.PivotFields("フィールド5").ClearAllFilters 'フィルターフィールドのクリア
.PivotFields("フィールド5").CurrentPage = "フィルターフィールド条件" 'フィルターフィールドの条件
'集計方法の設定
.PivotFields("値フィールド").Orientation = xlDataField
.PivotFields("値フィールド").Function = xlCount '集計方法をデータの個数に設定
'空白を0で埋める
.NullString = "0"
'フィルターをかける
.PivotFields("フィールド1").PivotFilters.Add2 xlCaptionIsGreaterThanOrEqualTo, , 50
End With
End Sub.PivotFilters.Add2 引数, , 条件
フィルターの引数一覧
・条件が文字の場合
xlCaptionEquals：指定の値に等しい
xlCaptionDoesNotEqual：指定の値に等しくない
xlCaptionBeginsWith：指定の値で始まる
xlCaptionDoesNotBeginWith：指定の値で始まらない
xlCaptionEndsWith：指定の値で終わる
xlCaptionDoesNotEndWith：指定の値で終わらない
xlCaptionContains：指定の値を含む
xlCaptionDoesNotContain：指定の値を含まない
xlCaptionIsGreaterThan：指定の値より大きい
xlCaptionIsGreaterThanOrEqualTo：指定の値以上
xlCaptionIsLessThan：指定値より小さい
xlCaptionIsLessThanOrEqualTo：指定の値以下
xlCaptionIsBetween：指定の範囲内
xlCaptionIsNotBetween：指定の範囲外
・条件が数字の場合
xlCaptionIsGreaterThan：指定の値より大きい
xlCaptionIsGreaterThanOrEqualTo：指定の値以上
xlCaptionIsLessThan：指定値より小さい
xlCaptionIsLessThanOrEqualTo：指定の値以下
xlCaptionIsBetween：指定の範囲内
xlCaptionIsNotBetween：指定の範囲外
・条件が日付の場合
xlSpecificDate：指定の値に等しい
xlBefore：指定の値より前
xlAfter：指定の値より後
xlDateBetween：指定の範囲内
使用例） ~.PivotFilters.Add2 xlDateBetween, , "2024/12/1", "2025/1/3"
・条件がラベルの値の場合
xlValueEquals：指定の範囲に等しい
xlValueDoesNotEqual：指定の値に等しくない
xlValueIsGreaterThan：指定の値より大きい
xlValueIsGreaterThanOrEqualTo：指定の値以上
xlValueIsLessThan：指定の値より小さい
xlValueIsLessThanOrEqualTo：指定の値以下
xlValueIsBetween：指定の範囲内
xlValueIsNotBetween：指定の範囲外
使用例）~.PivotFields("合格者名").PivotFilters.Add2 xlValueIsGreaterThanOrEqualTo, .PivotFields("年齢"), 15
・ピボットのデータ取得（統計用）
Dim pvName As String 'ピボットテーブル名
Dim wsName As String 'ワークシート名
Dim pvData As long 'データ格納
Dim field(1 to 10) As String '集計条件の変数
Dim field2(1 to 10) As String '集計条件の変数
Dim m As Integer '変数
wsName = "ピボットシート名"
pvName = "ピボットテーブル名"
'フィールド1の総数
pvData = Worksheets(wsName).PivotTables(pvName).GetData("フィールドのラベル名")
'個別条件で値を取得
pvData = Worksheets(wsName).PivotTables(pvName).GetData("行フィールドのラベル名" "列フィールドのラベル名")
'個別条件で値を取得（3つ）順番大事！行フィールドの後に列フィールド
pvData = Worksheets(wsName).PivotTables(pvName).GetData("行フィールドのラベル名1" "行フィールドのラベル名2" "列フィールドのラベル名")
'総計を取得
pvData = Worksheets(wsName).PivotTables(pvName).GetData("")
'変数を使用する場合の値を取得
pvData = Worksheets(wsName).PivotTables(pvName).GetData("フィールドのラベル名" & " " & field(m))
'行フィールドと列フィールドの検索条件の名前がかぶっている場合の値の取得方法
'ex)フィールドが違うけれど、同じラベル名の「検索条件1」を抽出する場合
pvData = Worksheets(wsName).PivotTables(pvName).GetData("フィールド名1[ラベル名1]" "フィールド名2[ラベル名1]")
'行フィールドと列フィールドの検索条件の名前がかぶっている場合の値の取得方法（変数）
field2(m) = "フィールド名1[" & field(m) & "]"
pvData = Worksheets(wsName).PivotTables(pvName).GetData("フィールドのラベル名" & " " & field2(m))・ピボットのソート
Dim pvName As String 'ピボットテーブル名
Dim wsName As String 'ワークシート名
wsName = "ピボットシート名"
pvName = "ピボットテーブル名"
'「フィールド1」ラベルを「昇順」にする
Worksheets(wsName).PivotTables(pvName).PivotFields("フィールド1").AutoSort xlAscending, "フィールド1"
'「商品」ラベルを「降順」にする
Worksheets(wsName).PivotTables(pvName).PivotFields("フィールド1").AutoSort xlDescending, "フィールド1"
いいなと思ったら応援しよう！
