概要
項目の除いた2行目以降に、数式と値が入り混じっていないか確認する
プログラムを作成した理由
例えば、給与金額毎に給与区分を判定する関数を用意したとして…(動画参考)
境界値チェックとして、
この値は時給、この値は低すぎるからエラー…
とテスト用に値貼り付けして境界値チェックを行ったとします。
この値貼り付け後の境界値テスト後に、
「あれ？テスト用に値貼り付けしたままだったっけ？本番用に数式反映しないと…」
と不安になる事が多発したので、
「2行目以降に数式と値の両方が入り混じってたら警告する」というコードを作成しました。
ソースコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | Option Explicit '概要 'アクティブシート全列に対し、下記のような状態の場合、エラーメッセージを表示 '2行目が数式なのに3行目以降に数式ではないが存在する '2行目が数式ではないのに3行目以降に数式が存在する Sub 数式リンク切れ確認マクロ() '変数定義 Dim EndRow As Long Dim EndColomn As Long Dim Colomn_Name As String Dim Err_RowsStr As String Dim ERR_MSG As String '判定フラグ Dim FormulaFlg As Boolean 'ループカウンタ Dim i As Integer Dim Rows_Count As Long Dim Colomn_Count As Integer Application.Calculation = xlCalculationManual '手動計算に Application.ScreenUpdating = False '画面描画を停止 Application.DisplayStatusBar = True 'ステータスバー表示 Application.StatusBar = "" 'ステータスバー文言初期化 EndColomn = ActiveSheet.UsedRange.Columns.Count '最終列 EndRow = ActiveSheet.UsedRange.Rows.Count '最終行 '列ループ For Colomn_Count = 1 To EndColomn '項目名作成 Colomn_Name = GetAlphaName(Colomn_Count) Colomn_Name = Colomn_Name & "列「" & Cells(1, Colomn_Count) & "」" '初期化 FormulaFlg = False '数式フラグ Err_RowsStr = "" 'エラー該当行 '行ループ For Rows_Count = 2 To EndRow Select Case Rows_Count '項目を除いた1案件目 Case 2 '数式判定 If Cells(Rows_Count, Colomn_Count).HasFormula Then '数式 FormulaFlg = True Else '数式ではない FormulaFlg = False End If '2案件目以降 Case Else '下記に一致しない場合、該当位置格納 'X行目が数式の場合、2行目は数式 'X行目が数式ではない場合、2行目は数式ではない If FormulaFlg = Cells(Rows_Count, Colomn_Count).HasFormula Then '何もしない Else Err_RowsStr = Err_RowsStr & Rows_Count & "," End If End Select Next 'エラー行が存在している場合 If Err_RowsStr <> "" Then '列名メッセージ_末尾「,」除外 Err_RowsStr = Left(Err_RowsStr, Len(Err_RowsStr) - 1) 'エラーメッセージ格納 ERR_MSG = ERR_MSG & _ Colomn_Name & Err_RowsStr & "行目" & vbLf & vbLf End If Next Application.StatusBar = "" 'ステータスバー文言初期化 Application.ScreenUpdating = True '画面描画を開始 Application.Calculation = xlCalculationAutomatic '自動計算に '完了メッセージ If ERR_MSG = "" Then MsgBox "リンク切れ行は存在しませんでした。" Else MsgBox "下記列にリンク切れ行が存在しています。" & vbLf & vbLf & ERR_MSG End If End Sub '列ナンバーをアルファベット列名に変換 Private Function GetAlphaName(ColomnNum As Integer) As String '変数定義 Dim ColomnName As String '列位置→アルファベット列名変換 ColomnName = Cells(1, ColomnNum).Address(True, False) ColomnName = Left(ColomnName, InStr(2, ColomnName, "$") - 1) '返却値 GetAlphaName = ColomnName End Function |
感想
本マクロは、
「値貼り付けしたままじゃないかな…大丈夫かな…」と
心配性な人にはオススメしたいコードです(笑)
私は毎回おまじないのように毎回使っています←
(過去に数回救われた経験有り)
こういった確認は人間ではなく、機械にやらせる方が確実&安心ですね
編集履歴
2022/02/26 新規作成
