マクロ：セルの範囲指定

エクセルマクロで困っています。
セルの範囲指定をしようとしています。
初心者過ぎて、よくわかりません。
現在のマクロ↓
Sub 済()
If ActiveCell.Column = 21 Then
Selection.FormatConditions.Delete '条件付き書式削除
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With

'色変え判定セル書き換え
ActiveCell.Offset(0, 5).Select
ActiveCell.FormulaR1C1 = "77"
ActiveCell.Offset(0, -5).Select
Else
answer = MsgBox("U列を選択して下さい", vbCritical)
End If
End Sub

やりたい事は、下記の通りです。
列Ｕがアクティブの時にＵ～ＡＣの行を塗りつぶし。
列は変動します。
今は、やり方がよく分からなかったため
オフセットで一つ一つ塗りつぶしてます。
マクロを組みすぎてファイルが重くなって困っています。
回答よろしくお願いいたします。

No.3 ベストアンサー 回答者： hige_082 回答日時： 2010/01/30 00:58

まとめてみました

Sub 済1()
Dim answer
If ActiveCell.Column = 21 Then
Selection.FormatConditions.Delete '条件付き書式削除
With Selection.Resize(, 9).Interior
.ColorIndex = 16
.Pattern = xlSolid
End With

'色変え判定セル書き換え
ActiveCell.Offset(, 13).FormulaR1C1 = "77"
ActiveCell.Offset(, 8).Select
Else
answer = MsgBox("U列を選択して下さい", vbCritical)
End If
End Sub

この回答へのお礼

お手数をお掛けしました。
質問内容が分かりにくかったですね。
申し訳ありません。。

お礼日時：2010/01/30 01:13

No.2 回答者： Yosha 回答日時： 2010/01/30 00:19

何をしたいか全体像が見えないので、とりあえず提示された　コードと同じ結果が得れるコードを書きます。

Sub test()
　Dim r As Long, c As Integer, answer

　r = Selection.Row
　c = Selection.Column

　If c = 21 Then
　　With Range(Cells(r, c), Cells(r, c + 8)).Interior
　　　.ColorIndex = 16
　　　.Pattern = xlSolid
　　End With

　　'色変え判定セル書き換え
　　Cells(r, c + 13).Value = "77"
　　Cells(r, c + 8).Select
　Else
　　answer = MsgBox("U列を選択して下さい", vbCritical)
　End If
End Sub

以上ですが、繰り返しのところの範囲を一括して選択すればOKです。
他にしたいことがあればコメントしてください。

この回答へのお礼

ありがとうございます。
やっぱり分かりにくかったですか。。
さっき試してみましたができました！
大変、勉強になりました。
ありがとうございました。

お礼日時：2010/01/30 01:03

No.1 回答者： hana-hana3 回答日時： 2010/01/30 00:16

＞列は変動します。

どのように変動するのでしょうか？
書かれたマクロではよく解りませんが・・・。

「色替え判定」の部分は解りませんが、下記でいかがでしょうか？
セルが決まっているなら、「済2」の方が解りやすいでしょう。


Sub 済()

If ActiveCell.Column = 21 Then
Selection.FormatConditions.Delete '条件付き書式削除

For i = 21 To 29
ActiveSheet.Columns(i).Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With
Next

'色変え判定セル書き換え
ActiveCell.Offset(0, 5).Select
ActiveCell = "77"
ActiveCell.Offset(0, -5).Select
Else
answer = MsgBox("U列を選択して下さい", vbCritical)
End If

End Sub

Sub 済2()

If ActiveCell.Column = 21 Then
Selection.FormatConditions.Delete '条件付き書式削除

ActiveSheet.Columns("U:AC").Select
With Selection.Interior
.ColorIndex = 16
.Pattern = xlSolid
End With

'色変え判定セル書き換え
Range("AH1") = "77"
Range("AC1").Select
Else
answer = MsgBox("U列を選択して下さい", vbCritical)
End If

End Sub

この回答へのお礼

すいません。
列が変動というのは・・
U列の中でアクティブセルが変動するって事です。
アクティブセルを含む、U～ACを塗りつぶしで・・
U1がアクティブで実行した場合は・・
（U1:AU1）としたかったのです。。

お礼日時：2010/01/30 01:10