\ 最大10%ポイントアップ! /

VBA 良く使うコード集!

【当サイトはプロモーションを含んでいます】

じょじお

この記事は良く使うコードをまとめようかなと思い立って作った記事です。

少しずつコピペしていこうと思っているので読みづらくすいません。少しずつ見やすいように整備していく予定です。コードの解説はこの記事では行いません。

目次

シート操作

STEP

セルの操作

STEP
よく使うフォントの操作
        With .Cells(1, 1)
            .Value = "value"
            .Font.Size = 26
            .Font.Bold = True
            .Font.color = red
        End With
STEP
非表示セルを再表示する。
    '非表示行列を再表示する。
    With St.Cells
        .EntireColumn.Hidden = False
        .EntireRow.Hidden = False
    End With
STEP
セルの結合がされていたら結合解除する。
With St.Cells(r, c)
    If .MergeCells Then
        .MergeArea.UnMerge
    End If
End With
STEP
全行を検索して特定のキーワードがあったら行を削除(下から上へ判定)
    Dim i As Long
    For i = 最終行 To 開始行 Step -1
        With St.Cells(i, 1)
            If .Value = "削除対象キーワード" Then
                .EntireRow.Delete
            End If
        End With
    Next
STEP
カレントリージョンの取得
Dim myRegion As Variant
myRegion = Range("A1").CurrentRegion
STEP
カレントリージョンを取得して、列方向に1列ずつ評価
Dim myRegion As Variant
myRegion = Range("A1").CurrentRegion

For i = LBound(myRegion , 2) To UBound(myRegion,2)
    If IsDate(myRegion (1, i)) = True Then
'処理
    End If
Next
STEP
最終行と最終列(非推奨)
    Dim r As Long 'collumn
    Dim c As Long 'row
    With ActiveSheet.Cells(1, 1)
        r = .End(xlDown).Row
        c = .End(xlToRight).Column
    End With

空白セルがある表では使えません。空白セルがある表では下から上に.end(xltop)した方がいいです。というよりもこの方法は安定性が低いのでもう一方の方法を使うことをおすすめします。

ソート・フィルタ

STEP





テーブル操作(ListObject)

ブック操作

Excelブックを保存する。

STEP
Excelブックを保存する。(ダイアログを表示してユーザーにファイル名の入力を求める。)
    on error resume next
    Dim str As String
    Str = Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & ThisWorkbook.Name
    Dim savename As String
    savename = InputBox("ファイル名を入力してください。", Default:=str)
    ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & savename
STEP

Excelファイルを開く、処理、閉じる

STEP
新規ファイルを開きます。
    Dim filename As String
    filename = "C:\Users\user\Desktop\Book1.xlsx"
    
    Dim Book As Workbook
    Set Book = Excel.Workbooks.Open(filename)
    
'処理
    
    Book.Close savechanges:=True
    Set Book = Nothing

▲Bookを開いて処理をして保存して閉じる。

STEP
ファイルダイアログを表示してユーザーに開くファイルを選択してもらいファイルを開きます。
    'ファイルをピックさせる。

    Application.ScreenUpdating = False
    On Error Resume Next

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Show
        new_book_name = .SelectedItems(1)
    End With
    
    'ファイル選択失敗したときの処理
    If Err.Number <> 0 Then
        MsgBox "ErrNum" & Err.Number & vbNewLine & Err.Description
        Debug.Print Err.Description
        Err.Clear
        Exit Sub
    End If
    
    Application.ScreenUpdating = True
処理系

Select Case

STEP
Select Case
    Select Case .Cells(r, c).Value
        Case 0
            処理

        Case Is <= 3200 '32pcs以上取得する
            処理
            
        Case 3201 To 35000 '125pcs以上取得する
            処理
            
        Case Is >= 35001
            処理
    End Select

if then

STEP
If Cells(8, 1).Value = "" Then
    Rows(8).Delete
End If

エラー処理・例外処理

STEP
エラーが発生しても停止せずに処理を続けます。(例外処理)
On Error Resume Next
処理
On Error GoTo 0

エラーが発生したときにユーザーフレンドリーな画面を表示させるときや、例外処理する時に使います。

STEP
エラーメッセージを表示させてマクロを強制終了します。
    On Error Resume Next
    'エラー処理
    If Err.Number <> 0 Then
        MsgBox Err.Number Err.Description & "エラーが発生したためマクロを終了します。頻発する場合はエラーメッセージとエラー番号を管理者に伝えてください。"
        Err.Clear
        Exit Sub
    End If
STEP
ダイアログを表示してユーザーにシート命名を求めます。このとき重複する名前があった場合、再入力を求め続けます。
On Error Resume Next
Do
    If Err.Number = 1004 Then ’シート名称重複エラー
        Err.Clear
    End If
    Worksheets(Worksheets.Count).Name = _
    InputBox("シート名を命名してください。", _
    Default:="new_sheet")
Loop Until Err.Number <> 1004

'エラー処理
On Error Resume Next
If Err.Number <> 0 Then
    MsgBox Err.Description & "マクロを終了します。"
    Err.Clear
    Exit Sub
End If

辞書:Dictionary(ハッシュ配列・ディクショナリー)

辞書 :Dictionaryのライブラリ参照設定は?

辞書(Dictionary)を使うときは、ライブラリ参照設定をすると構文の入力補助やサジェストを使うことができるので効率的にコーディングできるのでおすすめです。参照設定を行わなくても辞書を使うことはできます。

STEP
Excelを開いた状態で「Alt+F11」でVBEを開く
STEP
VBEのツールメニューの中の「参照設定」をクリックします。

▲ツール>参照設定

STEP
「Microsoft Scripting Runtime」にチェックを入れます。

Microsoft Scripting Runtimeにチェックを入れます。デフォルトではチェックはオフです。

辞書:Dictionaryの構文

STEP
辞書に重複を確認しながら登録する。
If dic.Exists(key) = False Then
    dic.Add key, value
    Debug.Print dic.Item(value)
Else
    Debug.Print value & "は登録済みのためスキップしました"
End If
STEP
辞書から全部取り出す。
    ‘■「キー」を取り出す
    For i = 0 To dic.Count – 1
        Debug.Print dic.Keys(i)
    Next i

    ‘■両方同時に取り出す(キー → アイテム)
    Dim Var As Variant
    For Each Var In dic
        Debug.Print Var & “,” & dic.Item(Var)
    Next Var
STEP
辞書から1個とりだす。

Excel VBAからOutlook送信

STEP
メールテンプレート.oftファイルを使ってメール送信する。
Sub メール作成(AttachFile As String)
'実行時バインディングで動作します。

    Dim MAILTEMPLETE As String
    On Error Resume Next
    MAILTEMPLETE = UserForm1.TxBx_メールテンプレフルネーム.Text
    If MAILTEMPLETE = "" Then
        MsgBox ("メールテンプレートが見つけられません。設定を行ってから実行してください。")
        Exit Sub
    End If
    
    Dim oApp As Object   'Outlook.Application 'Outlookのオブジェクト
    Dim objMAIL As Object  ' Outlook.MailItem 'Object 'メールのオブジェクト
    Dim myNameSpace As Object   'MAPI用
    Dim myFolder    As Object   'MAPI用
    Dim BodyString As String
    
    On Error Resume Next
    Set oApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If oApp Is Nothing Then
        Set oApp = CreateObject("Outlook.Application")
    End If
    Set objMAIL = oApp.CreateItemFromTemplate(MAILTEMPLETE)
    If Err.Number <> 0 Then
        MsgBox ("メール作成ができません。oft形式のテンプレートファイルのフルパスの設定を確認してください。")
        Err.Clear
    End If
    Set myNameSpace = oApp.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(6) '下記とやってることは同じ。実行時バインディングだと定数が使えないので数字で指定している。
    'Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
    
    objMAIL.Attachments.Add AttachFile
    BodyString = "・" & objMAIL.Attachments.Item(1).Filename & vbNewLine
    objMAIL.Subject = "MAILTEMPLETE" & Format(Date, "(yyyy/mm/dd(aaa))")
    objMAIL.htmlBody = Replace(objMAIL.htmlBody, "◆置換◆", BodyString)
    
    objMAIL.Display

    Set myFolder = Nothing
    Set myNameSpace = Nothing
    Set objMAIL = Nothing
    Set oApp = Nothing

End Sub

▲実行時バインディングなので参照設定は不要です。

STEP
メールテンプレートを使わないでメール送信する。

印刷設定

STEP
よく使う印刷設定
Sub 印刷設定(St As Worksheet)
    Application.ScreenUpdating = False
    With St.PageSetup
        .PrintArea = "A:J"  '印刷範囲の設定
        '.Orientation = xlPortrait '印刷向き 縦
        .Orientation = xlLandscape  '印刷向き 横
        .Zoom = False
        .FitToPagesTall = False
        .FitToPagesWide = 1  '横幅を1ページに収める
        .PrintTitleRows = "$3:$3" '1行目を印刷タイトル行にする
'        .CenterHorizontally = True
        .TopMargin = Application.CentimetersToPoints(1.9)
        .CenterHorizontally = True  '水平方向に中央配置

'        '下余白を 1.9cm に設定
'        .BottomMargin = Application.CentimetersToPoints(1.9)
'        '右余白を 1.8cm に設定
'        .LeftMargin = Application.CentimetersToPoints(1.8)
'        '左余白を 1.8cmm に設定
'        .RightMargin = Application.CentimetersToPoints(1.8)
'        'ヘッダー余白を 0.8cm に設定
'        .HeaderMargin = Application.CentimetersToPoints(0.8)
'        'フッター余白を 0.8cm に設定
'        .FooterMargin = Application.CentimetersToPoints(0.8)
        
        .LeftHeader = "" '左側ヘッダー:なし
        .CenterHeader = "&""メイリオ""&14" & " 納期確認シート" 'メイリオ フォントサイズ14 &Aでシート名
        .RightHeader = "&D &T"  '右側ヘッダー:日付 時刻
        .LeftFooter = "" '左側フッター:なし
        .CenterFooter = "&""メイリオ""&08" & " " & ThisWorkbook.Name       '中央ヘッダー:メイリオ、サイズ8で「」
        .RightFooter = "&P/&N"  '右側フッター:ページ数/総ページ数
    End With
    Application.ScreenUpdating = True
End Sub

ユーザーフォーム

STEP
リストボックスにシート名を追加する。
' リストボックスに、ブックに存在するすべてのワークシート名をリストする。
Private Sub UserForm_Initialize()
    Dim st As Worksheet
    For Each st In Worksheets
        Me.ListBox1.AddItem st.Name
    Next
End Sub
STEP
ユーザーフォームをEscキーで閉じれるようにする。
Private Sub UserForm_Activate()
    Application.OnKey "{ESC}", "UserFormClose"
end sub

Sub UserFormClose()
    Unload UserForm1
End Sub

モードレスなフォームの表示非表示に便利です。

その他

STEP
ダミーのオプション引数を渡す。(ユーザからマクロを隠蔽する)
Sub main(Optional dummy As String = "")

引数不要なプロシージャでも、ダミーでオプション引数を設定しておくとマクロの一覧画面に表示されないのでユーザーからマクロを隠ぺいできます。ユーザからは直接実行してほしくないマクロに設定しておくと便利です。

STEP
カットコピーモード無効
Application.CutCopyMode = False
MacでVBA

MacのVBAの注意点

MacでVBAするときに一番注意しなければいけない点は下記の2つかなと思います。

MacでVBAするときの注意点

  • デリミタ(パス区切り文字)が違う。
  • システムから表示させるダイアログ系がWindowsと違う。(ファイルピッカーとか)
    • Macのバージョンによっても違う
STEP
パス区切り文字
"folderName" & Application.PathSeparator & "fileName.txt"

WindowsとMac、どちらでも利用できるマクロにする場合、パスを記述する時は「\」や「/」をべた打ちせずに上記のキーワードApplication.PathSeparatorを使うと良いです。

お役に立てたらシェアお願いします!
  • URLをコピーしました!
  • URLをコピーしました!
目次