個人的によく使うExcel VBAのコード覚え書き

VBA開発をする時、基本的で簡単なコードであれば覚えているのですが、たいていググるか昔のファイルを開いてコピペしちゃってます。

それで十分だとは思うのですが、その都度サイトやファイルを開くのがめんどくさいので、この記事にまとめておくことにしました。

完全な個人用ですが、これからVBAを学習する人の参考になればと思います。

ファイルを開く

Dim openFileName As String

If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
    Workbooks.Open ThisWorkbook.Path & "\sample.csv"
Else
    openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
    If openFileName <> "False" Then
        Workbooks.Open openFileName
    Else
        MsgBox "キャンセルが押されました。" _
            & vbCrLf & "作業を中止します。"
        Exit Sub
    End If
End If

ブックと同一パスに指定のファイルがあればそのまま開き、無ければポップアップして選択し開く。

ブックを閉じる

Application.EnableEvents = False
ActiveWorkbook.Close SaveChanges:=True

閉じる際に出る何かしらのポップアップを拒否し、保存する場合のコード。

ディレクトリ内のブックを順番に開いて処理

Dim path, fso, file, files
Dim wb As Workbook

path = ThisWorkbook.path & "\サンプルフォルダ"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set files = fso.GetFolder(path).files

For Each file In files
    Set wb = Workbooks.Open(file)
    /* 各ブックに対する処理 */
    Application.EnableEvents = False
    ActiveWorkbook.Close SaveChanges:=True
Next file

VBA:フォルダ内のファイルを順次処理を参考にしました。

複数のExcelブックを1つにまとめる時に使えます。

名前を付けて保存

Dim saveFile As String
Dim saveName As String

saveName = "サンプル"

saveFile = Application.GetSaveAsFilename(saveName, FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")
ActiveWorkbook.SaveAs Filename:=saveFile, FileFormat:=xlNormal

ユーザが保存先や名前を自由に決められます。デフォルトでは「サンプル.xlsx」が入力されます。

ブックの操作

/* アクティブなブックを操作する場合 */
ActiveWorkbook.Worksheets(1).Range("A2").Select

/* マクロを動かしているブックを操作する場合 */
ThisWorkbook.Worksheets(1).Range("A2").Select

ワークシートを探す

Dim ws As Worksheet
Dim sheetFlg As Boolean

For Each ws In Worksheets
    If ws.Name = "サンプル" Then
        sheetFlg = True
    End If
Next

指定の名前がついたシートの存在を判定する。

表の最終行を取得し空白行を削除

Dim rowStart As Integer
Dim rowEnd As Integer
Dim colStart As Integer
Dim colEnd As Integer

'空白セルがある場合はここから
ActiveWorkbook.Worksheets(1).Range("A2").Select

rowStart = Selection.Row
rowEnd = Cells.SpecialCells(xlCellTypeLastCell).Row

colStart = Selection.Column
colEnd = Cells.SpecialCells(xlCellTypeLastCell).Column

'空白セルがない場合はここから
ActiveWorkbook.Worksheets(1).Range("A2").Select

startRow = Selection.Row
rowEnd = Selection.End(xlDown).Row

startCol = Selection.Column
rowCol = Selection.End(xlToRight).Column

基本はCtrl + Shift + ↓、あるいはCtrl + Shift + →の操作をした際の最終行・列を取得するが、途中で空白セルがある場合はうまく機能しないためSpecialCellsを使う。

ソート

Worksheets(1).Range(Cells(2, 1), Cells(100, 5)) _
    .Sort Key1:=Worksheets(1).Cells(2, 2), order1:=xlAscending, _
          Key2:=Worksheets(1).Cells(2, 3), order2:=xlDescending

ヘッダー行ではなくデータが始まる行を指定。

xlAscendingが昇順、xlDescendingが降順。

文字列を含んでいるかの分岐

Dim sample As String
Dim testFlg As Boolean

sampleFlg = False
If InStr(sample, "テスト") > 0 Then
    testFlg = True
End If

文字列を含んでいた場合1を返す。含んでいない場合は>を=にすればよい。

配列

Dim sample(3) As String

sample(1) = サンプル1
sample(2) = サンプル2
sample(3) = サンプル3

Excel VBAでは不都合がなければ0ではなく1からスタートすべし。

コピペ

Worksheets(1).Range("A2", "F" & i).Copy
Worksheets(2).Range("A2").PasteSpecial Paste:=xlPasteValues

このような場合、コピペするブックやシートがアクティブになった気がする(うろ覚え)

変数に格納して代入する場合はアクティブなブックやシートは変わらない。

置換

Range("A2", "A" & i).
Replace What:="/", Replacement:="", LookAt:=xlPart

Dim sample As String
sample = Replace(sample, "/", "")

2パターンあり、上はセル範囲の置換、下は変数の置換で使いやすい。

リストを作成する

Dim listName As Name
Dim a As Integer

a = 100

For Each listName In ThisWorkbook.Names
    If listName.Name = "サンプル" Then
        Range("サンプル").Name.Delete
    End If
Next

ActiveWorkbook.Names.Add _
    Name:="サンプル", _
    RefersTo:="=Sheet1!$A$2:$C$" & a

既にリストが存在していれば削除してから、新たにリストを作成する。

罫線を引く

Range("A2", "E50").Borders.LineStyle = xlContinuous

シートを保護・解除する

/* 解除 */
ActiveSheet.Unprotect
/* 保護 */
ActiveSheet.Protect

マクロ実行時のみ保護を解除する

ThisWorkbook.Worksheets("サンプル").Protect UserInterfaceOnly:=True

Withステートメントでコード省略

With ActiveSheet
    .Range("A2").Value = .Range("A1").Value
End With

これはよく使う、というよりも今まで使ってこなくて最近知った方法。

WithでActiveSheetと宣言しておけば、End Withの間は記述しなくてOKというもの。

「.」から記述し始めていますが、アクティブシートのA2にアクティブシートのA1の値を代入するというコードになります。

Do Loopで繰り返し処理

Do Until ActiveCell.Value = ""
    ActiveCell.Borders.LineStyle = xlContinuous
    ActiveCell.Offset(1, 0).Select
Loop

これも基本のキのはずなのに今まで使ってこなかったやつ。ずっとループはForで貫いていました。

Forは回数を指定するのに対し、Doは条件に合うまでループするのが違い。

アクティブセルが空白でなければ(値が入っていれば)罫線を設定し、アクティブセルを1行下にして条件分岐に戻る。アクティブセルが空白であればループを抜けます。

サンプルの場合、アクティブセルを1行動かす記述がないとループから抜け出せないという事態になってしまいます。条件分岐の対象を変えるコードがないといけないというわけですね。

Caseで分岐

Dim sample As String

sample = Application.InputBox("値を入力", "値入力ウィンドウ")

Select Case sample
    Case ""
        MsgBox ("入力なし" & vbCrLf & "処理終了")
        Exit Sub
    Case "False"
        MsgBox ("キャンセルが押されました" & vbCrLf & "処理終了")
        Exit Sub
    Case Else
End Select

文字列の前後にある空白を取り除く

Dim sample As String
sample = " サンプル "
sample = Trim(sample)

シートの枚数を数えて指定のシートをアクティブにする

Dim sheetCnt As Integer
sheetCnt = Worksheets.Count

For i = 1 To sheetCnt
    If sheetName = Worksheets(i).name Then
        Worksheets(i).Activate
        Exit For
    End If
Next

プロシージャを呼び出す

Call sample(aaa, bbb)

Private Sub sample(ByRef aaa As Integer, ByVal bbb As Integer)

()にはそのプロシージャに渡す引数を入力。

Private Subはモジュール内でのみ有効なプロシージャ。モジュールを越える場合はPublic Subにする。

ByRefは参照渡しで呼び出し先での値変更を反映させ、ByValは値渡しで値の変更は反映させない。

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です