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 saveFile As String
Dim saveName As String

saveName = "サンプル"

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

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

ブックの操作

ActiveWorkbook.Worksheet

s(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 rowEnd As Long

'空欄がある場合はここから
rowEnd = Cells.SpecialCells(xlCellTypeLastCell).Row

For i = row_end To 2 Step -1
    If WorksheetFunction.CountA(Rows(i)) = 0 Then
        Rows(i).Delete
    End If
Next

'空欄がない場合はここから
ActiveWorkbook.Worksheets(1).Range("A2").Select
rowEnd = Selection.End(xlDown).Row

基本は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 Long

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行動かす記述がないとループから抜け出せないという事態になってしまいます。条件分岐の対象を変えるコードがないといけないというわけですね。