none
背景色を利用したDeleteについて RRS feed

  • 質問

  • ⑤の下記コードにおいて、背景色「RGB(236, 236, 236) 」を指定して 塗りつぶしの行を削除しようとしました。しかし、結果は背景色「RGB(236, 236, 236) の行と、全く指定しない「RGB(255, 255, 204)」の行が同時に失われています。このことを自身で解消することができませんので、どなたか力を貸してください。よろしくお願いいたします。

    Sub select1()

     '①     
        Dim i As Long, lRow As Long, a As Long
        Dim selc1 As Worksheet
        Set selc1 = Worksheets("select1")

        With Worksheets("step5")

        a = 10

        lRow = Cells(Rows.Count, 1).End(xlUp).Row
            For i = 10 To lRow
                If .Cells(i, 18).Value = .Range("C4").Value And _
                    .Cells(i, 12).Value = .Range("C5").Value And _
                    .Cells(i, 13).Value = .Range("C6").Value And _
                    .Cells(i, 3).Value = .Cells(i + 1, 3).Value And _
                    .Cells(i, 17).Value <> "1000万" Then
                    .Rows(i).Copy selc1.Rows(a)
                    selc1.Range(selc1.Cells(a, 1), selc1.Cells(a, 30)).Interior.Color = _
                    RGB(236, 236, 236)

                    Do While .Cells(i, 3).Value = .Cells(i + 1, 3).Value
                    .Rows(i + 1).Copy selc1.Rows(a + 1)

                    i = i + 1
                    a = a + 1

                    Loop

                    a = a + 1

                End If
            Next i

                selc1.Range("A:AD").Columns.AutoFit

                .Rows("1:9").Copy selc1.Rows(1)
        End With
     '②
            For i = 10 To lRow
                If selc1.Cells(i, 9).Value = "-1" And _
                    selc1.Cells(i, 1).Interior.Color = RGB(236, 236, 236) Then
                    selc1.Range(selc1.Cells(i, 1), selc1.Cells(i, 30)).Interior.Color = _
                    RGB(240, 220, 100)

                    Do While selc1.Cells(i, 3).Value = selc1.Cells(i + 1, 3).Value
                    selc1.Range(selc1.Cells(i + 1, 1), selc1.Cells(i + 1, 30)).Interior.Color = _
                    RGB(255, 255, 204)

                    i = i + 1

                    Loop

                End If
            Next i
    '③ 
            For i = lRow To 10 Step -1
                If selc1.Cells(i, 9).Value = "-1" And _
                    selc1.Cells(i, 1).Interior.Color = RGB(255, 255, 204) Then
                    selc1.Rows(i).Delete
                End If
            Next i       
    '④
            For i = 10 To lRow
                If selc1.Cells(i, 1).Interior.Color = RGB(255, 255, 204) Then
                    selc1.Cells(i, 9).Value = "-1"
                End If
            Next i       
    '⑤
            For i = lRow To 10 Step -1
                If selc1.Cells(i, 1).Interior.Color = RGB(236, 236, 236) Then
                     selc1.Rows(i).Delete
                End If
            Next i

    End Sub

                                                                                                                                                                                                                              
    2020年1月16日 7:37