前に書いた(Excelで数式が入っているセルを探して印をつけるマクロ - Agrius_Akitaの日記)数式を探すマクロをちょっと改善
完全に文字列(【R11.C11】)にすると、一括選択ができないので。
数式(="【R11.C11】")に変換するようにしてみた。
機能番号6番追加〜
Option Explicit ' ================================================== ' ■数式チェック ' 処理内容を決める ' ================================================== Sub mcrFormulaChange() Dim flgDo As String ' ------------------------- ' 処理内容の選択と実行 ' ------------------------- flgDo = InputBox( _ Prompt:="数式セルをどうするか決めて、処理番号を入れて下さい" & vbNewLine & _ vbNewLine & _ "【1】:セルの背景色を変える" & vbNewLine & _ "【2】:セルを罫線で囲う" & vbNewLine & _ "【3】:数式を「行・列番号」へ置き換える" & vbNewLine & _ "【4】:1と2を実行" & vbNewLine & _ "【5】:1〜3を全て実行", _ "【6】:[β版]行列置換結果を計算式に", _ Title:="処理の選択") ' エラーチェック Select Case StrConv(flgDo, vbNarrow) ' 正しく入力している場合は処理開始 Case "1" Call subFormulaChange_Select(flgDo) Case "2" Call subFormulaChange_Select(flgDo) Case "3" Call subFormulaChange_Select(flgDo) Case "4" Call subFormulaChange_Select(flgDo) Case "5" Call subFormulaChange_Select(flgDo) Case "6" Call subFormulaChange_Select(flgDo) ' それ以外の場合は終了 Case Else Call MsgBox(Prompt:="処理を中止します") End End Select End Sub ' ================================================== ' ■数式チェック ' 選択範囲の数式セルへ印をつける ' ================================================== Sub subFormulaChange_Select(flgDo As String) Dim cleRange As New Collection Dim rngInput As Range Dim rngCell As Range Dim rngArea As Range Dim lngCol As Long Dim lngRow As Long ' ------------------------- ' 置換範囲の選択 ' ------------------------- ' キャンセル時のデータエラーを無視 On Error Resume Next ' 数式を探すセル範囲を選択 ' 既にセル選択している場合はデフォルトで入力しておく Set rngInput = Application.InputBox( _ Prompt:="数式セルを探す範囲を選択してください", _ Title:="数式セルを探す範囲の選択", _ Default:=Selection.Address(RowAbsolute:=False, ColumnAbsolute:=False), _ Type:=8) ' ★キャンセルチェック On Error GoTo 0 If rngInput Is Nothing Then Call MsgBox(Prompt:="処理を中止します") End End If ' マクロ実行中の画面描写をOFF ' InputBoxの動きを良くするため、ここでOFFにする。 Application.ScreenUpdating = False ' ループ用にセル範囲を取得 With cleRange ' 開始列 .Add Item:=rngInput.Column, Key:="ColStart" ' 開始行 .Add Item:=rngInput.Row, Key:="RowStart" ' 終了列 .Add Item:=rngInput.Column + rngInput.Columns.Count - 1, Key:="ColEnd" ' 終了行 .Add Item:=rngInput.Row + rngInput.Rows.Count - 1, Key:="RowEnd" End With ' ------------------------- ' 選択範囲の各セルが数式かチェック ' ------------------------- ' 列ループ For lngCol = cleRange("ColStart") To cleRange("ColEnd") ' 行ループ For lngRow = cleRange("RowStart") To cleRange("RowEnd") ' 処理セルを設定 Set rngCell = Cells(lngRow, lngCol) ' 数式か判断 If rngCell.HasFormula Then ' 結合セル全体を選択 Set rngArea = rngCell.Resize(rngCell.MergeArea.Rows.Count, rngCell.MergeArea.Columns.Count) Select Case StrConv(flgDo, vbNarrow) Case "1" ' 色を付ける rngArea.Interior.Color = RGB(120, 180, 240) Case "2" ' セルを囲う With rngArea.Borders .LineStyle = xlContinuous .Color = RGB(255, 0, 0) .Weight = xlMedium End With Case "3" ' 何行目・何列目か置き換える rngArea.Value = "【R" & lngRow & ".C" & lngCol & "】" Case "4" ' 色を付ける rngArea.Interior.Color = RGB(120, 180, 240) ' セルを囲う With rngArea.Borders .LineStyle = xlContinuous .Color = RGB(255, 0, 0) .Weight = xlMedium End With Case "5" ' 色を付ける rngArea.Interior.Color = RGB(120, 180, 240) ' セルを囲う With rngArea.Borders .LineStyle = xlContinuous .Color = RGB(255, 0, 0) .Weight = xlMedium End With ' 何行目・何列目か置き換える rngArea.Value = "【R" & lngRow & ".C" & lngCol & "】" Case "6" ' 色を付ける rngArea.Interior.Color = RGB(120, 180, 240) ' セルを囲う With rngArea.Borders .LineStyle = xlContinuous .Color = RGB(255, 0, 0) .Weight = xlMedium End With ' 何行目・何列目か置き換える rngArea.Value = "=" & """【R" & lngRow & ".C" & lngCol & "】""" Case Else ' 何もしない End Select End If Next lngRow Next lngCol ' マクロ実行中の画面描写を戻す Application.ScreenUpdating = True End Sub
.