VBAで色の付いているセルの行削除

VBAで色の付いているセルの行を削除することは出来ないでしょうか？
量が多すぎて一つ一つ削除すのは大変で間違えて削除してしまいそうなので・・・


－　文字または数字
■　色の付いたセル（赤）

　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ・・・
１－　－　－　－　－　－
２－　－　－　－　－　－
３－　－　－　■　－　－
４－　－　■　－　－　－
５－　－　■　－　－　－
６－　－　－　－　－　－
７－　－　－　■　－　－
８－　－　■　－　－　－
９－　－　■　－　－　－
10－　－　－　－　－　－

　　　　　　↓

　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ・・・
１－　－　－　－　－　－
２－　－　－　－　－　－
６－　－　－　－　－　－
10－　－　－　－　－　－

よろしくお願いします。

No.4 回答者： BLUEPIXY 回答日時： 2005/01/19 00:00

Public Sub 色の付いたセルのある行を消す()

Dim linePos, i

ActiveCell.SpecialCells(xlLastCell).Select
linePos = ActiveCell.Row

For i = linePos To 1 Step -1
If colored(Range(Rows(i).Address)) Then
Rows(i).Delete Shift:=xlUp
End If
Next
End Sub

'指定した範囲に色の付いたセルがあるか？
Function colored(r As Range) As Boolean
Dim x As Range
For Each x In r
If x.Interior.Color <> RGB(255, 255, 255) Then '白（色がついてない、標準の状態）でない
colored = True
Exit Function
End If
colored = False
Next
End Function

この回答へのお礼

出来ました！
有難うございました！

お礼日時：2005/01/19 09:02

No.3 ベストアンサー 回答者： shishishishi 回答日時： 2005/01/18 23:51

No1です。

いちいち行や列数をいれなくともいいように変えました。

Sub test2()
x = ActiveCell.SpecialCells(xlLastCell).Row
y = ActiveCell.SpecialCells(xlLastCell).Column
For i = x To 1 Step -1
For n = 1 To y
If Cells(i, n).Interior.ColorIndex <> xlNone Then Rows(i).Delete
Next n
Next i
End Sub

この回答へのお礼

追加アドバイス有難うございました！

お礼日時：2005/01/19 08:52

No.2 回答者： shkwta 回答日時： 2005/01/18 23:28

これでどうでしょうか。

シートモジュールを使用します(Sheet1等をダブルクリックして書きます）。
△と▲は、使っている色のインデックスを取得するために、見本として、色のついているどれかのセルの行番号と列番号を入れてください。
☆と★は、処理の対象とする範囲の、行の数と列の数を入れてください。

Sub 行削除()
　　Dim 行, 行数 As Long
　　Dim 列, 列数 As Integer
　　Dim 色 As Integer

　　色 = Cells(△, ▲).Interior.ColorIndex
　　行数 = ☆
　　列数 = ★

　　行 = 1
　　Do While 行 <= 行数
　　　　列 = 1
　　　　Do While 列 <= 列数
　　　　　　If Cells(行, 列).Interior.ColorIndex = 色 Then
　　　　　　　　Rows(行).Delete
　　　　　　　　列 = 1
　　　　　　　　行数 = 行数 - 1
　　　　　　Else
　　　　　　　　列 = 列 + 1
　　　　　　End If
　　　　Loop
　　　　行 = 行 + 1
　　Loop
End Sub

この回答へのお礼

有難うございます！
ＶＢＡはまだ初歩的な事しか分からないので助かりました。

お礼日時：2005/01/19 09:00

No.1 回答者： shishishishi 回答日時： 2005/01/18 23:22

シートの使用範囲を２２行（i）９列(n)としてやってみました。

実際のシートにあわせ数字は変えてください。

Sub test()
For i = 22 To 1 Step -1
For n = 1 To 9
If Cells(i, n).Interior.ColorIndex <> xlNone Then Rows(i).Delete
Next n
Next i
End Sub

この回答へのお礼

有難うございます！
何とかできそうです！

お礼日時：2005/01/19 08:50