マクロ作成の経緯
テストなどでエクセルでデータを比較する際、毎回IF文を駆使して対象のセルにコピペしていました。(こんな感じ)
どうにかこの無駄な作業をマクロ化できないかとまずはいろいろなサイトを調べました。
ですが、思ったような結果が得られるマクロを探し出すことができませんでした。。
それならば！と思い、自分で思い通りのマクロを１から作ることにしました。
イメージとしては、１行目、２行目の比較をするために、３行目に式を挿入して比較結果を出す感じです。
明細行が終わるまで比較式の追加を行う処理を作成しようと思います。
マクロ実行時の前提条件
[行比較マクロを行う前提条件]
①偶数行であること
②式ではなく値の比較を行う
③比較する２行の次の行の開始位置のセルを選択
④比較したいレコードを交互に配置する
⑤比較開始列がどちらもnullの場合は正しく動作しない
⑥比較終了列がどちらもnullの場合は比較対象にならない
実行マクロ
Sub ItemCheck(Optional RowInsFlg As String = "")
'
' ItemCheck 行比較
'
Dim i As Integer
Dim ActRow As Integer '選択行
Dim ActCol As Integer '選択列
Dim ChkRow As Integer '比較対象行(1行目)
Dim ChkCol As Integer '比較対象列
Dim Chkformula As String '数式を格納
Dim ItemCheckMaxColumn As Integer '最大列数
ActRow = Selection.Row '選択行をセット
ActCol = Selection.Column '選択列をセット
ChkRow = 0
ChkCol = 0
i = 1
'最大列数取得
ItemCheckMaxColumn = Columns.Count
'RowInsより呼び出された場合は処理しない
If RTrim(RowInsFlg) = "" Then
'画面更新の非表示
Application.ScreenUpdating = False
End If
'数式を利用するため、選択行に標準フォーマット行を追加
'行選択
Rows(ActRow & ":" & ActRow).Select
'行追加
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'フォーマット設定
Selection.NumberFormatLocal = "G/標準"
'最初の選択箇所に戻す
Cells(ActRow, ActCol).Select
'数式ではなく、値が設定されている行を比較対象とする
Do Until ActRow - i = 0
If Not Cells(ActRow - i, ActCol).HasFormula And RTrim(Cells(ActRow - i, ActCol).Value) <> "" Then
ChkRow = ActRow - i
Exit Do
End If
i = i + 1
Loop
'比較の数式を設定
'全て一致の場合の比較条件に変更
Chkformula = "=IF(EXACT(R[" & -(ActRow - ChkRow) & "]C,R[" & -(ActRow - ChkRow + 1) & "]C),"""",""×"")"
'式追加
ActiveCell.FormulaR1C1 = Chkformula
ActiveCell.Cells.FormatConditions.Delete
'条件付き書式設定
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""×"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535 '色指定
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'比較する最終列を取得
'データにnullがある場合も最終列まで比較を行うため、
'比較列の取得方法を変更
'比較行1行目の指定定数列を選択
Cells(ActRow - 2, ItemCheckMaxColumn).Select
'最終列からCtrl+←で値の設定されている箇所まで移動
Selection.End(xlToLeft).Select
'移動先の列数を取得
ChkCol = ActiveCell.Column
'比較行2行目の指定定数列を選択
Cells(ActRow - 1, ItemCheckMaxColumn).Select
'最終列からCtrl+←で値の設定されている箇所まで移動
Selection.End(xlToLeft).Select
'移動先の列数を取得
'比較行1行目、2行目の値が設定されている列の大きい方を比較最大行とする
If ChkCol < ActiveCell.Column Then
ChkCol = ActiveCell.Column
End If
'最初の選択箇所に戻す
Cells(ActRow, ActCol).Select
'選択行(数式セット済み)をコピー
Selection.Copy
'開始列から終了列まで選択
Range(Cells(ActRow, ActCol), Cells(ActRow, ChkCol)).Select
'コピーした数式を選択行に貼り付け
Selection.PasteSpecial Paste:=xlPasteAll
'最初の選択箇所に戻す
Cells(ActRow, ActCol).Select
'コピーモードを解除
Application.CutCopyMode = False
If RTrim(RowInsFlg) = "" Then
'画面更新の非表示を解除
Application.ScreenUpdating = True
End If
End Sub実行例
さいごに
自分で利用するためだけに作成しているため、変数の設定やエラーチェックは緩いです。VBAに慣れている方は必要に応じて変更するといいかもしれません。
今まで手作業で行っていたことが一発で処理することができるようになったため、格段に作業効率が上がりました。２行ごとにマクロを呼び出す必要がありますが、今までのIF文コピペ作業からは解放されました。Optionalの引数を設定していますが、今回は特に利用しません。今度は引数に設定している「RowInsFlg」を利用してさらにデータ比較の効率を向上していこうと思います。
