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

解決済みの質問

【エクセル】マクロ

すみません。
エクセルのマクロのプログラム教えてください。

セルA1~A30に 「1」~「5」のいずれかの数字が
入っています。
そのA列の数字をもとにB1~B30のセルの書式を
変えたいと思っています。

例えば、「1」なら赤色、「2」なら青色、「3」なら緑色・・・
となるように考えています。

for文で1~30まで繰り返し、if文とswitch文で実行すると
思うのですが、どのようなプログラムを書けばいいですか?

よろしくお願いします。
3種類なら条件式書式が使えるのですが、4種類以上だと使えないので
マクロで実行しようと思っています。

投稿日時 - 2008-10-09 23:37:59

QNo.4390243

暇なときに回答ください

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

Selsect Case文でしょうか 
後から一括して処理するならこんなマクロでもできます。標準モジュールシートに貼り付けてください。(値が1~4までしか書いていませんけど…)

Sub Macro1()
Dim idx As Integer
 For idx = 1 To 30
  Select Case Cells(idx, "A").Value
   Case Is = 1
    Cells(idx, "B").Font.ColorIndex = 3
   Case Is = 2
    Cells(idx, "B").Font.ColorIndex = 5
   Case Is = 3
    Cells(idx, "B").Font.ColorIndex = 4
   Case Is = 4
    Cells(idx, "B").Font.ColorIndex = 6
   Case Else
    Cells(idx, "B").Font.ColorIndex = xlAutomatic
  End Select
 Next idx
End Sub

入力したタイミングで色を変えるなら、以下のマクロをシート名タブ右クリック→コードの表示で開く画面に貼り付けてください

Private Sub Worksheet_Change(ByVal Target As Range)
Dim trg As Range
 Set trg = Intersect(Target, Range("A1:A30"))
 If Not trg Is Nothing Then
  For Each trg In Target
   Select Case trg.Value
    Case Is = 1
     trg.Offset(0, 1).Font.ColorIndex = 3
    Case Is = 2
     trg.Offset(0, 1).Font.ColorIndex = 5
    Case Is = 3
     trg.Offset(0, 1).Font.ColorIndex = 4
    Case Is = 4
     trg.Offset(0, 1).Font.ColorIndex = 6
    Case Else
     trg.Offset(0, 1).Font.ColorIndex = xlAutomatic
   End Select
  Next trg
 End If
End Sub

投稿日時 - 2008-10-10 00:00:47

ANo.2

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

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

回答(4)

ANo.4

>セルの書式を変えたいと思//
文字色かセルのパターン色か。
パターーん色ではないかと思って
#3のご回答とキホンは同じだが、
Sub test03()
d = Range("A65536").End(xlUp).Row
C = Array(0, 3, 5, 6, 8, 12, 14)
For i = 1 To d
Cells(i, "B").Interior.ColorIndex = C(Cells(i, "A"))
Next i
End Sub
このように、対照表をプログラムの中に定義するとコードが簡単。
>if文とswitch文で実行すると
思うのですが、どのようなプログラムを書けばいいですか
これにとらわれないこと。Case文でしょう。
VBAではIF文を出来るだけ使わないようにするのが、勉強のコツ。
メソッドなどで、IF文の使用は減らせることが多い。
>3種類なら条件式書式が使えるのですが、4種類以上だと使えないので
エクセル2007かどうか質問に書くべき。

投稿日時 - 2008-10-10 10:59:32

ANo.3

対照表を使ってもできます。
Sub test()
Dim colorTable As Variant
Dim i As Long

On Error Resume Next
colorTable = Array(0, 3, 5, 4, 6)
For i = 1 To 30
Cells(i, 2).Font.ColorIndex = colorTable(Cells(i, 1).Value)
Next i
End Sub

投稿日時 - 2008-10-10 00:24:41

ANo.1

こんにちは

参考
http://www.eurus.dti.ne.jp/~yoneyama/Excel/jyo-syo.html#jyo4-vba

では。

投稿日時 - 2008-10-09 23:54:37

あなたにオススメの質問