Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4165 / 13644 ツリー ←次へ | 前へ→

【58083】以前の式に色を変える機能を追加したい (。。j) 08/10/1(水) 16:31 質問[未読]
【58087】Re:以前の式に色を変える機能を追加したい ichinose 08/10/1(水) 17:34 発言[未読]
【58088】Re:以前の式に色を変える機能を追加したい (。。j) 08/10/1(水) 18:18 お礼[未読]

【58083】以前の式に色を変える機能を追加したい
質問  (。。j)  - 08/10/1(水) 16:31 -

引用なし
パスワード
   こんにちは。
以前に教えていただいたVBに追加していただきたくお願いします。
下記は以前、数式だけ入ったセルとその数式から答えが導き出されているセルを同時に選択して、答えが導き出されたセルだけを'値の貼り付け’の様に数式を消し値だけにしてもらった式なのですが・・・。その答えが導き出されて、値だけになると同時に赤から黒の文字に変えたい場合はどうすればいいのでしょうか?文字は全て初めから赤くしています。宜しくお願いしますm(_ _)m

Sub 値段の決定()
  Dim rng As Range
  On Error Resume Next
  Set rng = Selection
  If Err.Number = 0 Then
   If rng.count > 2 Then
   Set rng = rng.SpecialCells(xlCellTypeFormulas, xlLogical + xlNumbers + xlTextValues)
    
            
    If Err.Number = 0 Then
      For Each crng In rng.Areas
      crng.Value = crng.Value
       Next
      End If
   Else
    MsgBox "複数(二つ以上のセル範囲を選択してください"
    End If
   End If
  On Error GoTo 0
End Sub

【58087】Re:以前の式に色を変える機能を追加したい
発言  ichinose  - 08/10/1(水) 17:34 -

引用なし
パスワード
   ▼(。。j) さん:
こんにちは。

>以前に教えていただいたVBに追加していただきたくお願いします。
>下記は以前、数式だけ入ったセルとその数式から答えが導き出されているセルを同時に選択して、答えが導き出されたセルだけを'値の貼り付け’の様に数式を消し値だけにしてもらった式なのですが・・・。その答えが導き出されて、値だけになると同時に赤から黒の文字に変えたい場合はどうすればいいのでしょうか?文字は全て初めから赤くしています。宜しくお願いしますm(_ _)m
>
>Sub 値段の決定()
>  Dim rng As Range
>  On Error Resume Next
>  Set rng = Selection
>  If Err.Number = 0 Then
>   If rng.count > 2 Then
>     Set rng = rng.SpecialCells(xlCellTypeFormulas, xlLogical + xlNumbers + xlTextValues)
>    
>            
>    If Err.Number = 0 Then
>      For Each crng In rng.Areas
        with crng
         .Value = .Value
         .Font.ColorIndex = 0
         end with 
>        Next
>      End If
>   Else
>     MsgBox "複数(二つ以上のセル範囲を選択してください"
>     End If
>   End If
>  On Error GoTo 0
>End Sub

こんなとこでしょうか?

【58088】Re:以前の式に色を変える機能を追加したい
お礼  (。。j)  - 08/10/1(水) 18:18 -

引用なし
パスワード
   ▼ichinose さん:

ありがとうごさいます!!!すごいです!!!
またおねがいしますm(_ _)m

4165 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free