LoginSignup
0
5

More than 1 year has passed since last update.

ExcelVBAマクロのチートシート

Last updated at Posted at 2022-05-03

はじめに

Excel 2019 on Windows10 を対象としています。
公開されている情報を参照して、プライベートの時間に整理したものです。
順次追記予定です。

関連記事

元に戻す/やり直しへの対応

Excel では VBA マクロの各種関数でシート内容を加工してしまうと、マクロ実行後に元に戻す/やり直しの履歴がリセットされてしまい、マクロ実行前の状態に戻せなくなることがあります。このセクションでは、履歴を維持したい場合の対応方法と注意点について記載します。

  • SendKeys によりショートカットキーを実行した場合には、元に戻す/やり直しの履歴が維持されるため、シート内容を加工する処理には SendKeys を用いるとよい
  • マクロ実行中に SendKeys の操作結果を反映するためには DoEvents を2回実行する。SendKeys の Wait オプションは有効に機能しない。DoEvents を3回以上実行すると履歴がリセットされる場合がある。サブルーチンの最初に DoEvents を実行した場合は挙動がおかしくなる。これらの条件は環境に依存しているかもしれない
  • Application.ScreenUpdating や Application.CutCopyMode を変更すると、同様に履歴がリセットされる場合があるので、履歴を維持したい場合は動作確認をするか、なるべく変更を避ける
  • ボタンを連続クリックすると誤動作する場合があるが、VBA では厳密な再入防止はできないので、時間間隔をあけて操作してもらう
  • 参考:SendKeys ステートメント
Public Sub 次の行を挿入()
    SendKeys "{DOWN}"
    DoEvents
    DoEvents
    
    Selection.EntireRow.Select
    
    SendKeys "^{+}"
    DoEvents
    DoEvents
End Sub
  • VBAによるセルの値変更を伴う処理では、SendKeys の結果が反映されるタイミングと値変更のタイミングがずれてしまうことがあるので、元に戻せなくなることを許容して、各種関数での加工をすることになる
  • 元に戻せない操作を伴う場合は、事前に確認メッセージを表示するとよい
Public Sub 次の行を挿入2()
    ' 元に戻すことができなくなることの確認をする
    If MsgBox("元に戻す操作はできませんが、実行しますか", vbOKCancel, "次の行を挿入2") = vbCancel Then
        Exit Sub
    End If
    Selection.EntireRow.Offset(1, 0).Insert  ' 次の行を挿入する    
    Selection.EntireRow.AutoFit  ' 行幅を自動調整する
End Sub

選択中セルの操作

Selection により選択中セルの Range オブジェクトを取得して操作できます。

    ' 選択中でなければ Nothing になっている
    If Selection Is Nothing Then
        Exit Sub
    End If

    ' アドレスを取得する
    ' 例えば、単一セル選択時は"$A$1"、複数セル選択時は"$A$1:$C$3"となる
    Debug.Print Selection.Address

    ' 選択範囲の各セルに対して繰り返す
    Dim cell As Variant  ' セル
    For Each cell In Selection
        Debug.Print cell.Address
    Next

    ' 選択範囲の各行に対して繰り返す
    Dim row As Variant
    For Each row In Selection.rows
        Debug.Print "ROW:" & row.Address
        For Each cell In row.Cells
            Debug.Print cell.Address
        Next
    Next

    ' 選択範囲の左上のセルのみ選択する
    ' Cells(行, 列)により選択範囲における相対位置を指定して単一セルを選択できる
    ' 左上が(1, 1)となる
    Selection.Cells(1, 1).Select

    ' テキストを取得する
    Debug.Print Selection.Cells(1, 1).Text
    Debug.Print Selection.Cells(1, 1)  ' 受け取り側が String 型であれば .Text は省略できます

    ' セルの値を設定する
    Selection.Cells(1, 1) = "ABC"

    ' セル位置はインデクスでも指定できる。例えば2行3列を選択時は下記に対応する
    ' | 1 | 2 | 3 |
    ' | 4 | 5 | 6 |
    ' セル位置を指定しない場合は、複数セル選択時にNullになる
    Debug.Print Selection(1)

    ' 元の選択範囲を保持する。Setが必要
    Dim org As Range  ' 元の選択範囲
    Set org = Selection

    ' 次の行を選択する
    ' Offset(行, 列)により相対位置を指定してずらし、Selectにより選択できる
    ' このとき、元の選択範囲のサイズが維持されるが、結合セルがあると選択範囲が変わる
    ' 元に戻す/やり直しの履歴は維持されるが、Selectによる選択の操作は履歴に含まれない
    Selection.Offset(1, 0).Select

    ' 行全体を選択する
    Selection.EntireRow.Select

    ' 列全体を選択する
    Selection.EntireColumn.Select

    ' 行全体をコピーして次の行に挿入する
    ' このとき、元に戻す/やり直しの履歴は維持される
    Selection.EntireRow.Copy
    Selection.EntireRow.Offset(1, 0).EntireRow.Select
    SendKeys "^{+}"
    DoEvents
    DoEvents

    ' 元の選択範囲に戻す
    org.Select

使用範囲の選択

ActiveSheet.UsedRange により使用範囲の Range オブジェクトを取得して操作できます。

    ' 使用範囲を選択する
    ActiveSheet.UsedRange.Select

    ' 使用範囲の右上のセルを選択する
    With ActiveSheet.UsedRange
        .Cells(1, .Columns.Count).Select
    End With

アドレス指定による操作

ActiveSheet.Range によりアドレスを指定して操作できます。

    ' E3セルのテキストを表示
    Debug.Print ActiveSheet.Range("E3")

    ' E3:E5を範囲選択する
    ActiveSheet.Range("E3:E5").Select

重なる範囲の取得

Intersect を用いて範囲のAND条件を求められます。

    ' 同じ行の別の列を選択
    Debug.Print Intersect(Range("N10").EntireRow, Range("L:L")).Address  ' "$L$10"が表示される

    ' 全行を対象にすると時間がかかるので、使用範囲のE列に対してのみ処理することで、処理時間を短縮する
    Dim cell As Range  ' セル
    For Each cell In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("E:E"))
        Debug.Print cell.Address
    Next

クリップボードの操作

下記の関数を作成して呼び出すことでテキストをコピー/取得できます。

Public Sub SetTextToClipboard(text As String)
    ' テキストをクリップボードにコピーする
    With CreateObject("Forms.TextBox.1")
        .text = text
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
    End With
End Sub

Public Function GetTextFromClipboard() As String
    ' クリップボードからテキストを取得する
    With CreateObject("Forms.TextBox.1")
        .MultiLine = True
        If .CanPaste = True Then .Paste
        GetTextFromClipboard = .text
    End With
End Function

テキストの判定

Like 演算子を活用することで、テキストの判定が容易になります。

    ' 選択中セルのテキストを取得
    Dim text As String  ' 選択中セルのテキスト
    text = Selection(1)
    
    ' テキストにABCが含まれない場合にメッセージを表示して中断する
    If Not text Like "*ABC*" Then
        MsgBox "ABCを含むセルを選択してください", vbOKOnly, "ABCセルの選択"
        Exit Sub
    End If

テキストの分割

Split によりテキストを分割できます。

    ' 複数セルをコピーした後に実行すると、イミディエイトウインドウに各セルのテキストを表示する
    Dim text As String  ' クリップボードから取得したテキスト
    Dim rows As Variant  ' 行配列
    Dim row As Variant  ' 行
    Dim items As Variant  ' 項目配列
    Dim item As Variant  ' 項目
    
    text = GetTextFromClipboard()
    rows = Split(text, vbCrLf)
    If UBound(rows) = -1 Then
        Debug.Print "改行が含まれていない"
    End If
    
    For Each row In rows
        items = Split(row, vbTab)
        If UBound(items) = -1 Then
            Debug.Print "タブが含まれていない"
        End If
        For Each item In items
            Debug.Print item
        Next
    Next

図形の操作

Shape オブジェクトにより図形を取り扱うことができます。

    ' 選択中のシートに含まれる各図形に対して繰り返す
    Dim shp As Shape  ' 図形
    For Each shp In ActiveSheet.Shapes
        ' 図形の種類を表示する
        Debug.Print shp.AutoShapeType

        ' 図形の左側座標と幅を表示する
        Debug.Print shp.Left, shp.Width

        ' 図形にテキストがあれば表示する
        If shp.TextFrame2.HasText Then
            Debug.Print shp.TextFrame2.TextRange
        End If
    Next

リストの活用

Collection によるリストを用いて、テキストを保持したり、区切り文字で結合できます。

Private Function JoinList(target As Object, delim As String)
    ' リスト項目のテキストを結合する
    '
    ' Args:
    '   - target (Object): 対象リスト={テキスト}
    '   - delim (String): 区切り文字

    Dim res As String  ' 結合結果
    Dim text As Variant  ' テキスト
    For Each text In target
        res = IIf(res = "", text, res & delim & text)
    Next
    JoinList = res
End Function

Public Sub 動作確認()
    ' 各セルのテキストをカンマ区切りで結合して表示する
    Dim cell As Variant  ' セル
    Dim itemList As New Collection  ' 項目リスト    
    For Each cell In Selection
        itemList.Add cell
    Next    
    Debug.Print JoinList(itemList)
End Sub

辞書の活用

Dictionary オブジェクトによる辞書を用いることで、Switch 文を置き換えてスマートに実装できます。

Public Sub 動作確認()
    ' 対象図形の種類を指定する
    Dim targetTypes As Object  ' 対象図形タイプ
    Set targetTypes = CreateObject("Scripting.Dictionary")
    targetTypes.Add msoShapeFlowchartDocument, "ドキュメントを表す図形"
    targetTypes.Add msoShapeFlowchartMultidocument, "複数のドキュメントを表す図形"

    ' 選択中のシートに含まれる対象図形のテキストを表示する
    Dim shp As Shape  ' 図形
    For Each shp In ActiveSheet.Shapes
        ' 対象図形のみを処理する 
        If Not targetTypes.Exists(shp.AutoShapeType) Then Goto Next_shp
        ' 図形にテキストがあれば表示する
        If shp.TextFrame2.HasText Then
            Debug.Print shp.TextFrame2.TextRange
        End If
Next_shp:
    Next
End Sub

辞書のソート

VBA にソート処理は用意されていないため、サブルーチンを実装する必要があります。シンプルなコードになるため、選択ソートアルゴリズムがお勧めです。

Private Sub Sort(ByRef pvarArray As Variant)
    ' 配列をソートする
    '
    ' Args:
    '   - pvarArray (Variant): ソート対象の配列
    
    Dim i As Long
    Dim j As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim varSwap As Variant
 
    iMin = LBound(pvarArray)
    iMax = UBound(pvarArray)
    For i = iMin To iMax - 1
        iMin = i
        For j = (i + 1) To iMax
            If pvarArray(j) < pvarArray(iMin) Then iMin = j
        Next
        varSwap = pvarArray(i)
        pvarArray(i) = pvarArray(iMin)
        pvarArray(iMin) = varSwap
    Next
End Sub

Public Sub 動作確認()
    ' 対象図形の種類を指定する
    Dim targetTypes As Object  ' 対象図形タイプ
    Set targetTypes = CreateObject("Scripting.Dictionary")
    targetTypes.Add msoShapeFlowchartDocument, "ドキュメントを表す図形"
    targetTypes.Add msoShapeFlowchartMultidocument, "複数のドキュメントを表す図形"

    ' 対象図形の値順にソートして表示する
    Dim indexList As Variant
    indexList = targetTypes.keys
    Sort indexList
    For Each index In indexList
        Debug.Print index, targetTypes.Item(index)
    Next
End Sub

テキストを含むセルの検索

Find, FindNext によりセルを検索できます。

Private Function FindText(target As Range, text As String, Optional LookAt As Variant = xlWhole) As Collection
    ' 対象範囲からテキストを含むセルを検索する
    '
    ' Args:
    '   - target (Range): 対象範囲
    '   - text (String): テキスト
    '   - LookAt (Variant): 検索条件=完全一致(xlWhole)|部分一致(xlPart)、省略時は 完全一致(xlWhole)
    '
    ' Returns:
    '   - foundList (Collection): 検索結果リスト={検索結果}

    Dim firstAddress As String  ' 最初の検索結果のアドレス
    Dim found As Range  ' 検索結果
    Dim foundList As New Collection  ' 検索結果リスト
    
    ' 対象範囲からテキストを含むセルを検索する
    Set found = target.Find(text, LookIn:=xlValues, LookAt:=LookAt)
    If Not found Is Nothing Then
        firstAddress = found.Address
        Do
            foundList.Add found
            Set found = target.FindNext(found)
        Loop While Not found Is Nothing And found.Address <> firstAddress
    End If
    
    ' 検索結果リストを返す
    Set FindText = foundList
End Function

Public Sub 動作確認()
    ' C列からテキストを検索してアドレスを表示する
    Dim found As Variant  ' 検索結果
    For Each found In FindText(Range("C:C"), "テキスト")
        Debug.Print found.Address
    Next
End Sub

合計の計算

WorksheetFunction.Sum により指定範囲の合計を計算できます。

    Debug.Print WorksheetFunction.Sum(Range("H6:I6"))

ファイルの選択

Application.GetOpenFilename によりファイルを選択できます。

    ' ファイルを選択する
    Dim path As String  ' パス名
    path = Application.GetOpenFilename(Title:="ファイルを選択")
    If path = "False" Then
        Exit Sub  ' 未選択のため中断
    End If

フォルダの選択

Application.FileDialog によりフォルダを選択できます。

' この変数定義はモジュールファイルの先頭(他の関数定義より前)に記述しないと正しく認識されない
Private 出力先を選択_LastOutdir As String  ' 前回選択した出力先ディレクトリ

Public Sub 出力先を選択()
    Dim outdir As String  ' 出力先ディレクトリ

    ' 出力先ディレクトリを選択する
    ' もし前回選択していればその結果を用いる
    outdir = 出力先を選択_LastOutdir
    If outdir = "" Then
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "出力先ディレクトリを選択"
            If .Show = False Then
                Exit Sub  ' 未選択のため中断
            End If
            outdir = .SelectedItems(1)
        End With
    Else
        出力先を選択_LastOutdir = outdir
    End If
End Sub

パス名の加工

Dir により存在するファイルのファイル名部分のみを抽出できます。

    ' tmpl に含まれる "-テンプレート" の部分を model に置き換えて、
    ' ディレクトリを outdir に置き換える
    path = outdir & "\" & Replace(Dir(tmpl), "-テンプレート", "-" & model)

リンクの作成

ActiveSheet.Hyperlinks.Add により、選択中のシートにリンクを作成できます。

    ' 選択中のセルに path へのリンクを追加して「●」を表示する
    ActiveSheet.Hyperlinks.Add Anchor:=Selection(1), Address:=path, TextToDisplay:="●"

リンクの取得

Hyperlinks オブジェクトからリンクの情報を参照して取得できます。

    ' 選択セルにリンクがあれば表示する
    If Selection(1).Hyperlinks.Count <> 0 Then
        Debug.Print ActiveWorkbook.path & "\" & Selection(1).Hyperlinks(1).Address
    End If

コメントの作成

Range.AddComment によりコメントを作成できます。

    ' 選択セルにコメントを追加する
    With Selection(0)
        .AddComment "コメント"
        With .Comment.Shape
            .TextFrame.AutoSize = True
            .Height = Application.Max(.Height * .Width / 200, 50)
            .Width = 200
        End With
    End With

セル背景色の変更

ColorIndex プロパティによりセルの背景色を変更できます。

    Selection(1).Interior.ColorIndex = 0  ' クリア(0)
    Selection(2).Interior.ColorIndex = 44  ' ゴールド(44)

ブックの作成

Workbooks.Add によりブックを作成できます。

    ' テンプレート tmpl から新たにブックを作成して、加工し、path に保存する
    With Workbooks.Add(tmpl)
        With .Worksheets("シート名")
            .Range("E3") = "E3"
            .Range("E4") = "E4"
        End With
        .SaveAs path
    End With

ブックの参照

Workbooks.Open により既存のブックを開くことができます。

    ' 既存ブックを表示せずに開き、対象セルのテキストを取得する
    Application.ScreenUpdating = False
    With Workbooks.Open("既存ブックのパス名", ReadOnly:=True)
        Windows(.Name).Visible = False
        With .Worksheets("シート名")
            Debug.Print .Range("E3")
        End With
        .Close SaveChanges:=False
    End With
    Application.ScreenUpdating = True

繰り返しのスキップ

Goto を活用して他言語における continue 相当の処理ができます。

    ' 選択範囲の各セルにおいて、リンクが設定されていれば処理をする
    Dim cell As Variant
    For Each cell In Selection
        ' リンクが設定されていなければ無視する
        ' VBAには continue がないので Goto で代用することで、インデントを下げている
        If cell.Hyperlinks.Count = 0 Then GoTo Next_cell

        ' リンクに対して処理する
        Debug.Print cell.Hyperlinks(1).Address

Next_cell:
    Next

無限ループの中断

Alt + ESC キーを連続入力することで、無限ループを停止できます。

0
5
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
5