私がExcelVBAでよく使う便利なコード・スニペットまとめ

コードってその人の癖とかあると思うんですが、私が個人的によく使っているモノ、更によく使うんだけどアレどうやって書くんだっけ…！みたいなものもまとめてみました。

ActiveWorkbook.ActiveSheet.Range("A1").Clear
↓
Range("A1").Clear 'ActiveWorkbook.ActiveSheet.を省略して記述できる

Dim ws As Worksheet 'ワークシート変数を宣言
Set ws = ActiveWorkbook.ActiveSheet 'ワークシートを変数へ代入
ws.Range("A1").Clear 'ワークシートを指定して処理

Dim ws As Worksheet 'ワークシート変数を宣言
Set ws = Workbooks("Book1").Sheets("Sheet1") 'ブック名、シート名を指定して変数へ代入
ws.Range("A1").Clear 'ワークシートを指定して処理

セル・シート・ブック操作

クリア

Range("A1").Clear '値・書式設定・罫線などすべてクリア
Range("A1").ClearContents '値だけクリア

色

Range("A1").Font.ColorIndex = xlAutomatic '文字色を自動に
Range("A1").Font.ColorIndex = 2 '文字色変更（インデックス表記）
Range("A1").Font.Color = RGB(0, 0, 0) '文字色変更（RGB表記）

Range("A1").Interior.ColorIndex = xlNone '背景色をなしに
Range("A1").Interior.ColorIndex = 2 '背景色変更（インデックス表記）
Range("A1").Interior.Color = RGB(0, 0, 0) '背景色変更（RGB表記）

連続したデータが入っている範囲の最終端を取得

n = Range("A1").End(xlDown).Row '縦方向
n = Range("A1").End(xlToRight).Column '横方向

最後のセルから最終端を取得

n = Cells(Rows.Count, 1).End(xlUp).Row '縦方向
n = Cells(1, Columns.Count).End(xlToLeft).Column '横方向

'シートを明示する場合
Dim ws As Worksheet 'ワークシート変数を宣言
Set ws = Workbooks("Book1").Sheets("Sheet1") 'ブック名、シート名を指定して変数へ代入
n = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row '縦方向
n = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column '横方向

シートで使われているセルの最終端を取得

n = ActiveSheet.UsedRange.Rows.Count '最終行
n = ActiveSheet.UsedRange.Columns.Count '最終列

変数を含んだ範囲指定

Range(Cells(a, b), Cells(c, d)).Select

'シートを明示する場合
Dim ws As Worksheet 'ワークシート変数を宣言
Set ws = Workbooks("Book1").Sheets("Sheet1") 'ブック名、シート名を指定して変数へ代入
ws.Range(ws.Cells(a, b), ws.Cells(c, d)).Select

選択されてる範囲の一部を取得

n = Selection.Cells(1).Row '最初のセルの行
n = Selection.Cells(Selection.Count).Row '最後のセルの行
n = Selection.Cells(1).Column '最初のセルの列
n = Selection.Cells(Selection.Count).Column '最後のセルの列

罫線の操作

'基本形
Range("A1:E5").Borders.LineStyle = xlContinuous '実線をひく

'線の種類
With Range("A1:E5").Borders
  .LineStyle = xlContinuous '実線
  .LineStyle = xlDash '破線
  .LineStyle = xlDot '点線
  .LineStyle = xlDouble '二重線
  .LineStyle = xlNone '削除
End With

'線の太さ
With Range("A1:E5").Borders
  .Weight = xlHairline '極細
  .Weight = xlThin '細（指定しなければこれ）
  .Weight = xlMedium '中
  .Weight = xlThick '太
End With

'線の色
With Range("A1:E5").Borders
  .ColorIndex = xlAutomatic '自動（指定しなければこれ）
  .ColorIndex = 3 '赤
  .ColorIndex = 5 '青
End With

'線の細かい位置
With Range("A1:E5")
  .Borders.LineStyle = xlContinuous '枠と格子全部に適用
  .Borders(xlEdgeTop).LineStyle = xlContinuous '上辺
  .Borders(xlEdgeRight).LineStyle = xlContinuous '右辺
  .Borders(xlEdgeBottom).LineStyle = xlContinuous '下辺
  .Borders(xlEdgeLeft).LineStyle = xlContinuous '左辺
  .Borders(xlInsideHorizontal).LineStyle = xlContinuous '中横線
  .Borders(xlInsideVertical).LineStyle = xlContinuous '中縦線
  .Borders(xlDiagonalUp).LineStyle = xlContinuous '右上がり斜線
  .Borders(xlDiagonalDown).LineStyle = xlContinuous '右下がり斜線
End With

並び替え

'A1:E100範囲をC1を基準に昇順に並び替え
Range("A1:E100").Sort Key1:=Range("C1"), order1:=xlAscending '降順はxlDescending

'3つまで優先キーを設定できる
Range("A1:E100").Sort _
  Key1:=Range("C1"), order1:=xlAscending, _
  Key2:=Range("B1"), order2:=xlDescending, _
  Key3:=Range("D1"), order3:=xlAscending

ブックを開く

Workbooks.Open "（フルパス）ブック名.xlsm"
Workbooks.Open Filename:="（フルパス）ブック名.xlsm", ReadOnly:=True '読み取り専用で開く

開いたブックを変数に格納したいときは、

Dim wb As Workbook
Set wb = Workbooks.Open("（フルパス）ブック名.xlsm")

こうすると開くと同時にWorkbookオブジェクトを取得できる。

Dim wb As Workbook
Set wb = Workbooks.Open(fileName:="（フルパス）ブック名.xlsm", ReadOnly:=True)

読み取り専用ならこのように。

ブックを閉じる

wbという変数にWorkbookオブジェクトが格納されているとして、

wb.Close
wb.Close saveChanges:=True '保存して閉じる
wb.Close saveChanges:=False '保存しないで閉じる

保存

wb.Save '上書き保存
wb.SaveAs "（フルパス）新ブック名.xlsm" '別名保存

コピペ

Range("A1").Copy 'コピー
Range("A1").PasteSpecial 'ペースト
Range("A1").PasteSpecial Paste:=xlPasteValues '値だけペースト
Range("A1").PasteSpecial Paste:=xlPasteFormats '書式だけペースト
Range("A1").AutoFill Destination:=Range("A1:A5") 'オートフィル
Application.CutCopyMode = False 'コピーモード解除

ファイル・フォルダ操作

Name 変更前のファイル名(フルパス) As 変更後のファイル名(フルパス) 'ファイル名変更
FileCopy コピー前のファイルのフルパス, コピー後のファイルのフルパス 'ファイルコピー
Kill 対象ファイルのフルパス 'ファイル削除
MkDir パス名 'フォルダ作成

ファイル・フォルダの存在場所

str = ThisWorkbook.Path '現在操作しているブックのパス
str = ThisWorkbook.Name '現在操作しているブックのファイル名
str = ThisWorkbook.FullName '現在操作しているブックのフルパス
str = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") 'マイドキュメントのパス
str = CreateObject("WScript.Shell").SpecialFolders("Desktop") 'デスクトップのパス

文字列操作

連結

str = "サンプルテキスト" & smp_txt & "sampletext" '変数が混ざっても大丈夫

数値を文字列に変換

str = CStr(n) '変数nは数値であること

総文字数を取得

n = Len(対象文字列)

文字の抜き出し

str = Left(対象文字列, n) '対象文字列の左からn文字抜き出す
str = Right(対象文字列, n) '対象文字列の右からn文字抜き出す
str = Mid(対象文字列, n, i) '対象文字列の左からn文字目からi文字抜き出す

置換

str = Replace(対象文字列, 置換前文字, 置換後文字)
'例
str = Replace(str, " ", "")
str = Replace(str, "　", "")
'↑よくこうやって半角スペース、全角スペースを取り除いています

変換

str = StrConv(対象文字列, vbNarrow) '半角へ
str = StrConv(対象文字列, vbWide) '全角へ
str = StrConv(対象文字列, vbLowerCase) '小文字へ
str = StrConv(対象文字列, vbUpperCase) '大文字へ
str = StrConv(対象文字列, vbKatakana) 'カタカナへ
str = StrConv(対象文字列, vbHiragana) 'ひらがなへ

含まれているか

n = InStr(対象文字列, 探す文字列)
'見つかればその最初の文字数を返し、見つからなければ0を返す

日付のあれこれ

日付のフォーマット変更

str = Format(対象物(Dateなどの日付), "yyyy/mm/dd")

PCの設定によってDateで取得した日付のフォーマットがバラバラだったりするので…

日付の計算

d = DateAdd(設定値, 計算数, 対象)
'設定値：年→"yyyy", 月→"m", 日→"d", 週→"ww", 時→"h", 分→"n", 秒→"s"

'例
d = DateAdd("d", 1, Date) '1日プラス
t = DateAdd("h", -1, Time) '1時間マイナス

ちょっとしたスニペット

「ファイルを開く」ウインドウを出す

CreateObject("WScript.Shell").CurrentDirectory = 任意のパス '開くフォルダを指定
str = Application.GetOpenFilename("ﾌｧｲﾙ,*.*")
'strには選択されたファイルのフルパス、キャンセル時にはFalseが返る
'strをStringで宣言しているときには
If str = "False" Then Exit Sub
'のように""で括ってエラー処理をする（Variantで宣言するのもいいかも）

フォルダ・ファイルの検索

str = Dir(対象物, 属性) '属性：vbNormal→ファイル, vbDirectory→フォルダ
'存在する場合はその名前を、存在しなければ""を返す

'例
If Dir(fol, vbDirectory) = "" Then 'フォルダが存在しなければ
  If MsgBox("該当フォルダが存在しません。作成しますか？", vbOKCancel) = vbOK Then
    MkDir fol 'フォルダ作成（変数folはフルパスであること）
  End If
End If

シート内検索

Dim fnd As Range, str As String
Dim row1 As Integer, col1 As Integer

str = "sample" '検索文字列

Set fnd = Range("A1:C100").Find(str) '検索
If Not fnd Is Nothing Then '見つかったとき
  fnd.Font.ColorIndex = 3 '該当セルのフォントを赤に
  row1 = fnd.Row '該当セルの行取得
  col1 = fnd.Column '該当セルの列取得
End If

省略

Sheets("sheet1").Range("A1").Interior.ColorIndex = 6 'セルの色
Sheets("sheet1").Range("A1").RowHeight = 20 'セルの高さ
Sheets("sheet1").Range("A1").ColumnWidth = 10 'セルの幅

こういう横に長くなってしまうコードを

With Sheets("sheet1").Range("A1")
  .Interior.ColorIndex = 6 'セルの色
  .RowHeight = 20 'セルの高さ
  .ColumnWidth = 10 'セルの幅
End With

withを使ってまとめるとスッキリ！

Dim rng As Range 'Rangeオブジェクトで宣言
Set rng = Sheets("sheet1").Range("A1") '変数にセット

rng.Interior.ColorIndex = 6 'セルの色
rng.RowHeight = 20 'セルの高さ
rng.ColumnWidth = 10 'セルの幅

省略とはちょっと違うけど対象に合った型のオブジェクト変数に入れちゃえばこんなふうにもかけます。

メッセージボックス

MsgBox ("サンプルテキスト") 'OKのみ
n = MsgBox("サンプルテキスト", vbOKCancel) '戻り値(n)：OK→vbOK=1, キャンセル→vbCancel=2
n = MsgBox("サンプルテキスト", vbYesNoCancel) '戻り値(n)：はい→vbYes=6, いいえ→vbNo=7, キャンセル→vbCancel=2
n = MsgBox("サンプルテキスト", vbYesNo) '戻り値(n)：はい→vbYes=6, いいえ→vbNo=7

'例
If MsgBox("○○です。続けますか？", vbOKCancel) <> vbOK Then End
'↑yes以外が選択されたときは処理を終了します

高速化

Application.ScreenUpdating = False
'処理
Application.ScreenUpdating = True

関数の書き方

Sub sample() 'サブルーチン
  Dim beforeValue As 処理前の型, afterValue As 処理後の型

  afterValue = getFnc(beforeValue) 'beforeValueを関数へ引渡して返り値をafterValueへ
End Sub

Function getFnc(ByVal before_value As 処理前の型) As 処理後の型 '関数
  'before_valueを使っていろいろ処理する
  getFnc = 処理結果 'この値がサブルーチンのafterValueに入る
End Function

同じような処理をするなら関数にしちゃったほうがスッキリして可読性も上がります。アルファベット←→数値間の変換あたり関数にしておくと便利です。

かなり駆け足で紹介してみました！使いやすいように省いてある値もあったりするので、思うようにいかないときはググったりしてみてください！