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 ’フィルターの選択解除
Application.StatusBar = ”xxxxx” ‘画面左下に表示
下記は事例
実例
Sub Show完了率()
‘ 処理を高速化するための設定
Application.ScreenUpdating = False
Dim i As Long
Dim TotalRows As Long
Dim Percentage As String
TotalRows = 1000 ‘ 処理対象の行数
‘ ステータスバーに初期メッセージを表示
Application.StatusBar = “処理を開始します…”
‘ — メイン処理のループ —
For i = 1 To TotalRows
‘ セルに値を書き込む処理(時間がかかる処理を想定)
Cells(i, 1).Value = “データ-” & i
‘ ‘ —————————————————-
‘ 【重要】ステータスバーを更新する処理
‘ 処理の進捗率を計算し、文字列として整形
Percentage = Format(i / TotalRows, “0%”)
‘ ステータスバーに進捗メッセージを更新して表示
Application.StatusBar = “データを処理中… 完了率: ” & Percentage
‘ —————————————————-
Next i
‘ 処理が完了したら、カスタムメッセージをクリアする
Application.StatusBar = False ‘ または Application.StatusBar = “処理が完了しました!”
Application.ScreenUpdating = True
MsgBox “全データの処理が完了しました。”, vbInformation
End Su
‘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 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
列はシステム設計上固有の意味を持つのに対して、行は各行の状況によって異なる操作をするため列操作のような固定的な処理をしないのが一般的です。
‘行をソートする(一番小さい空白行より上が有効)
Range(“A1”).Sort Key1:=Range(“A1”), Order1:=xlAscending, _
Key2:=Range(“C1”), Order2:=xlDescending, Header:=xlYes
‘行をソートする(途中の行が空白でも可、A列で最大行を求めてZ列までを)
Dim MaxRow As Long
With ActiveSheet
MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Sort.SortFields.Clear
’ 第1キー:A列 昇順
.Sort.SortFields.Add Key:=.Range(“A2:A” & MaxRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
’ 第2キー:C列 降順
.Sort.SortFields.Add Key:=.Range(“C2:C” & MaxRow), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange .Range(“A1:Z” & MaxRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
End With
‘行を削除する
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
シート・ブックの追加に関するメソッドです
‘シートを追加する
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名”
シートのクリアーはデータ処理するうえで必須事項です。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