1.制御系

2.ステータス確認系

3.列操作系

4.行操作系

5.シート・ブック操作 

6.クリアー系

7.関数の挿入

8.小技


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 'フィルターの選択解除

 

 2.ステータス確認系

 '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

 3.列操作系

'列を非表示にする

  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

 'データがある範囲を1行目で判断してクリアーする

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.関数の挿入

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  'A列で最大行を求める

Range("C2").Select

       ActiveCell.FormulaR1C1 =  "=RC[-2]+RC[-1]"

      Selection.AutoFill Destination:=Range("C2:C" & MaxRow), Type:=xlFillDefault

  Range("C2").Select