エクセル VBA 指定色セルを値化（全シート対象）

質問

エクセル2010を使用しています。
VBA（マクロ）で以下の作業を実行したいと考えていますが、
初心者につき、ご教示いただけますでしょうか。

Book内の全Sheetを対象として、
特定の色（RPG：180,198,231）のセルを全て値化したいです。

他色のセルにも式が入っているのですが、それ等は崩したくないので
個々に値化してゆくしかないのですが、
指定色（RPG：180,198,231）のセル位置がまちまちな上に多数あり、
その上シートもかなりな数あるため、自動化できたらと考えています。
※値化するセルに入っている式は、簡単なリンク式です。

尚、必要の無い（表外）セルは無色で設定してあります。
また、その表のフチ（？）を「＃」で囲っているため、
これをKyeに「次の行へ移動」や「次のSheetへ移動」等が設定できるでしょうか？

1つづつのコードは、検索すれば（参考にできるものが）出てくるものもありますが、
それらを　どう組み合わせればうまく作動するのか
または、処理条件を　どう設定すれば良いのかが、よくわかっていません。

知識不足で申し訳ありません！
ご指導いただけますと幸いです。

よろしくお願いします！！

回答No.1

ushi2015 · ベストアンサー

こんにちは
Sub test()
　　Dim s As Worksheet
　　Dim t As Range
　　Dim r As Range
　　For Each s In Worksheets
　　　　On Error Resume Next
　　　　Set t = s.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
　　　　On Error GoTo 0
　　　　If Not t Is Nothing Then
　　　　　　For Each r In t
　　　　　　　　If r.Interior.Color = RGB(180, 198, 231) Then
　　　　　　　　　　r = r.Value
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　Next
End Su
こんな、感じでしょうか？

お礼

とてもとても助かりました。
ありがとうございました！！！

回答No.2

kagakusuki

「値化」とは、もしかしますと関数によってセルに入っている現在の値を、関数によらずに直接セルに入力するという事なのでしょうか？(コピーしたセルと同じセルに対して、値のみを張り付けたのと同じ結果)
　もしそれで宜しければ下記の様なVBAとなります。
　尚、2枚目以降のシートの中に「関数が入力されているセルが一切ないシート」があった場合、その前のシートを処理する際に

Set SearchRange = ws.Cells.SpecialCells(xlCellTypeFormulas, _
xlTextValues + xlNumbers + xlLogical + xlErrors)

の所でSearchRangeの中に格納されたセル範囲が残っていますと、SearchRangeの中身がNothingではないため、wsに格納されているシートには関数が入っているセルが存在していないのにもかかわらず、
Not SearchRange Is Nothing
の判定結果がTRUEとなってしまい、既に値化済みとなっている前のシートのセル範囲に対して、再度、値化の処理を繰り返すという無駄な処理を行う事になりますので、それを防ぐために、

Next ws

の直前に

Set SearchRange = Nothing

という処理を行う事で、SearchRangeの中身をリセットする様になっております。

Sub QNo9242547_エクセル_VBA_指定色セルを値化_全シート対象()

Dim ws As Worksheet, c As Range, SearchRange As Range, SearchColor As Long
SearchColor = RGB(180, 198, 231)

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

For Each ws In Sheets
On Error Resume Next
Set SearchRange = ws.Cells.SpecialCells(xlCellTypeFormulas, _
xlTextValues + xlNumbers + xlLogical + xlErrors)
On Error GoTo 0
If Not SearchRange Is Nothing Then
For Each c In SearchRange
If c.Interior.Color = SearchColor Then c.Value = c.Value
Next c
End If
Set SearchRange = Nothing
Next ws

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

遅くなりましたが、ご教示ありがとうございます！参考になりました！今後に役立てたいと思います！