プログラマーのネタ帳
- VBAのメソッドは長文が多く、私は全て暗記できません。そこでExcelにあらかじめよく使用するものを貼り付けて持ち歩いています。
- これを参考に皆さんもメソッドや定型文のネタ帳を作ることをおすすめ致します
- ここではそのままCopyして貼り付けられるよう編集を最低限に記述します。
1.制御系
Application.ScreenUpdating = False 'ディスプレイ出力抑止
Application.Calculation = xlCalculationManual '関数自動計算抑止
Application.ScreenUpdating = True 'ディスプレイ出力再開
Application.Calculation = xlCalculationAutomatic '関数自動計算再開
Application.DisplayAlerts = False 'オペレータへの警告抑止
'ここに "ブック名".close などのメソッドなどを使用する
Application.DisplayAlerts = True 'オペレータへの警告再開
'オートフィルターの設定
If ActiveSheet.AutoFilterMode Then
Else
Rows("1:1").Select
Selection.AutoFilter
End If
'オートフィルターの削除
If ActiveSheet.AutoFilterMode Then
Rows("1:1").Select
Selection.AutoFilter
Else
End If
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'フィルターの選択解除
２.ステータス確認系
'A列の最終行を求める
Dim MaxRow As Long
MaxRow = Cells(Rows.Count, "A").End(xlUp).Row
’1行目の最終列数を求める
Dim Max1 As Long
Max1 = Cells(1, Columns.Count).End(xlToLeft).Column
'列によって最大行が異なる時、その最も大きな値を求める
Dim MaxRow As Long
With ActiveSheet.UsedRange
On Error Resume Next
MAXRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
If MAXRow < 2 Then MAXRow = 2
Err.Clear
End With
'行によって最大列数が異なる時、その最も大きな値を求める
Dim MaxCol As Long
With ActiveSheet.UsedRange
On Error Resume Next
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
Err.Clear
End With
'セルに（関数による）エラーがあるとき、それを検出する
Sub エラー対応()
Dim i As Long
i = 3
If IsError(Cells(i, 2)) Then
Cells(i, 3) = "エラー"
End If
End Sub
３.列操作系
'列を非表示にする
Columns("F:G").Select
Selection.EntireColumn.Hidden = True
'列をスクロールする
ActiveWindow.ScrollColumn = 15
'列を挿入する
Columns("H:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'列の切り取りと指定位置挿入貼付
Columns("G:H").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
'列のコピーとクリップボードのクリアー
Columns("G:H").Select
Selection.Copy
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
'列の高速コピー（クリップボード未使用）
Columns("G:H").copy columns("D")
'別シートへの高速コピー
Sheets("Sheet2").Select
Columns("A").Copy Sheets("Sheet3").Columns("C")
'列の削除
Columns("H:J").Select
Selection.Delete Shift:=xlToLeft
4.行操作系
列はシステム設計上固有の意味を持つのに対して、行は各行の状況によって異なる操作をするため列操作のような固定的な処理をしないのが一般的です。
'行をソートする（一番小さい空白行より上が有効）
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("C1"), Order2:=xlDescending, Header:=xlYes
'行をソートする（途中の行が空白でも可、A列で最大行を求めてZ列までを）
Dim MaxRow As Long
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:Z" & MaxRow).Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("C1"), Order2:=xlDescending, Header:=xlYes
'行を削除する
Dim a, b As Long
a = 4
b = 6
Rows("" & a & ":" & b & "").Delete
または
Range(Rows(a), Rows(b)).Delete
もしAからC列だけを削除するのならば
Range("A" & a & ":" & "C" & b & "").Delete Shift:=xlUp
'特定条件の行（12列目が 0）を削除する
For i = Maxrow To 2 Step -1
If Cells(i, 12) = 0 Then
Cells(i, 1).EntireRow.Delete 'cellsを指定すると行全部が削除される
End If
Next
'行を挿入する （現在 selectされているセルより）
Rows(i).Insert
'任意の位置に任意の行を挿入する
Sub 任意行挿入()
Dim n, i As Long
n = 2 '挿入位置
i = 3 '挿入する行数
Rows(n & ":" & n + i - 1).Insert '2行目の位置から3行挿入する
'2、3、4行目が空白となる Rows("2:3").Insert と同じ結果
End Sub
'重複の削除 1列目の項目が重複していた場合、一番最初に現れた行以外を削除します
Range("A:C").RemoveDuplicates Columns:=Array(1), Header:=xlYes
'連結行数の取得 A5のセルがについていくつの行が連結しているかを求めます
Dim su1 As Long
su1 = Range("A5").MergeArea.Rows.Count
5.シート・ブック操作
シート・ブックの追加に関するメソッドです
'シートを追加する
Worksheets.Add
最後尾に追加する
Worksheets.Add after:=Worksheets(Worksheets.Count)
シートをコピーする
Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
Set ws = ActiveSheet
ws.Name = ”New_Sheet"
シートを削除する
Application.DisplayAlerts = False '確信してシートを削除するときは確認メッセージを出さない
Sheets("old_Sheet").Delete ’確信して⇒他のシートから作業用にコピーして作成したような場合（≠ソースデータ）
Application.DisplayAlerts = True
Bookを追加する
Workbooks.add
Book名を変更する（保存時にしか変更できません）
MyDir = ActiveWorkbook.Path 'Bookを追加する前に実行しておく
ThisWorkbook.SaveAs MyDir & "\" & "新Book名"
6.クリアー系
シートのクリアーはデータ処理するうえで必須事項です。Accessとか他の言語では『抽出』が重要な役割を担いますがVBAは抽出が苦手です（処理時間がかかる）。そこであるシートを別シートに丸ごと（あるいは列を選択して）Copyした後、条件に合わない行を削除するのがおすすめです。この時Copy先のシートに何か残っていると不都合が発生するので、事前にクリアーしておきます。
'フィルタの選択を解除してクリアする
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
Worksheets("Sheet1").Cells.Clear
'Sheetを無条件にクリアーする
Worksheets("Sheet1").Cells.Clear
'Sheetについて属性以外をクリアーする
Worksheets("Sheet1").Cells.ClearContents ’2023/3/28 訂正
'2行目以下をクリアーする（ただし最初の空白行の手前まで有効）
Worksheets("シート名").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
'データがある範囲を１行目で判断してクリアーする
Dim MaxRow As Long
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:Z" & MaxRow).clear
'余白の削除 実在データより後ろの余白を消します。ただし一度セーブしないと結果は確認できません。
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
MaxRow = Maxrow + 1
Max2 = Cells.SpecialCells(xlCellTypeLastCell).Row
Range(MaxRow & ":" & Max2).EntireRow.Delete
7.関数の挿入
いくらマクロが便利でもExcel関数の方が便利な時があります。
Vlookupや単純なかけ算など1,2件のデータ修正をするたびにマクロを実行をするのは面倒だし演算漏れの危険があります。関数の入っている列を触らずにあとでドラッグダウンしてもよいのですが、何かの条件で全行削除となった場合は関数を打ち直さなければなりません。
そこでデータ領域の最上段に関数を代入して下にコピーするという手順を取ります。ここで問題になるのはVBAで関数をコピーする場合は相対表記でないと正しくコピーされないというということです。
つまり C2 のセルに = A2 + B2 と代入してそれをVBAでコピーすると、全く同じ文字列が下にコピーされて C3のセルにもC4のセルにも同じ式が入ってしまうのです。
そこで C2のセルには =RC[-2]+RC[-1] と相対表記入れておく必要があるのです。これは大変ですね。この相対表記への変換をするには『マクロの記録』を使うと便利です。C2のセルに= A2 + B2 打ち込むのを記録すると
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]" と記録されます。
これを使用します
Dim MaxRow As Long
MaxRow = Cells(Rows.Count, "A").End(xlUp).Row 'Ａ列で最大行を求める
Range("C2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
Selection.AutoFill Destination:=Range("C2:C" & MaxRow), Type:=xlFillDefault
Range("C2").Select