こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

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

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


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

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

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

投稿日時 - 2016-10-14 12:44:46

QNo.9242547

困ってます

質問者が選んだベストアンサー

こんにちは
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
こんな、感じでしょうか?

投稿日時 - 2016-10-14 13:45:26

お礼

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

投稿日時 - 2016-10-14 14:36:25

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

 「値化」とは、もしかしますと関数によってセルに入っている現在の値を、関数によらずに直接セルに入力するという事なのでしょうか?(コピーしたセルと同じセルに対して、値のみを張り付けたのと同じ結果)
 もしそれで宜しければ下記の様な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

投稿日時 - 2016-10-14 15:08:08

お礼

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

投稿日時 - 2016-10-27 14:45:07

あなたにオススメの質問