前回紹介したデータ比較マクロをさらに進化させ、新旧データを並び替えしながら比較するマクロを作成しました。
マクロ実行時の前提条件
[行比較マクロを行う前提条件]
①偶数行であること
②式ではなく値の比較を行う
③比較開始行の先頭のセルを選択
④比較したいレコードを上下に配置
４行比較する場合は、更新前４行、更新後４行の順に配置
⑤比較開始列がどちらもnullの場合は正しく動作しない
⑥比較終了列がどちらもnullの場合は比較対象にならない
実行マクロ
前回作成したItemCheckを呼び出ししますので、事前に作成します。
Sub RowIns()
'
' 行比較(並び替え)
'
Dim i As Integer
Dim j As Integer
Dim SttRow As Integer
Dim SttCol As Integer
Dim EndRow As Integer
Dim RowHalfCnt As Integer
Dim StatusCnt As Integer
'画面更新の非表示
Application.ScreenUpdating = False
SttRow = Selection.Row
SttCol = Selection.Column
Selection.End(xlDown).Select
EndRow = Selection.Row
RowHalfCnt = (EndRow - SttRow + 1) / 2
i = 0
'実行前、実行後のデータを間に差し込む
Do Until i = RowHalfCnt - 1
'実行ステータスを表示
Application.StatusBar = "実行中..." & Left(String(Int(i / (RowHalfCnt - 1) * 5), "■") & String(10, "□"), 10)
Rows(SttRow + RowHalfCnt + i & ":" & SttRow + RowHalfCnt + i).Select
Selection.Cut
Rows(SttRow + i * 2 + 1 & ":" & SttRow + i * 2 + 1).Select
Selection.Insert Shift:=xlDown
i = i + 1
Loop
'ステータスの状態カウントを保持
If RowHalfCnt - 1 = 0 Then
StatusCnt = StatusCnt + 5
Else
StatusCnt = StatusCnt + Int(i / (RowHalfCnt - 1) * 5)
End If
Cells(SttRow, SttCol).Select
i = 0
j = 0
'明細終了までデータ比較処理を実行
Do Until i = RowHalfCnt
'実行ステータスを表示
Application.StatusBar = "実行中..." & Left(String(StatusCnt, "■") & String(Int(i / (RowHalfCnt) * 5), "■") & String(10, "□"), 10)
j = j + 2
Cells(SttRow + j + i, SttCol).Select
'チェック処理
Call ItemCheck("1")
i = i + 1
Loop
Cells(SttRow, SttCol).Select
'画面更新の非表示を解除
Application.ScreenUpdating = True
'ステータスバーの解放
Application.StatusBar = False
End Sub実行例
さいごに
最初に作成したItemCheckをうまく利用して、行の連続比較機能を作成することができました。
データの更新前後の状態を一発で視覚的に確認できるようになったため、作業効率が格段にアップしました。ステータスバーを追加したことで比較データ数が増えた場合に、進捗が確認できるようになりました。最初作成したステータスバーなしの頃は、いつ処理が終わるのかが全くわからなかったです。。今後の改善点としては、途中で処理を停止する機能の追加を考えています。