Slette linjer, hvori der findes tekst med en given farve

Må der sorteres i arket?

marker det område, der skal tjekkes, kun en kolonne af gangen, kør så makroen.

Sub DeleteRedAndBlueRows()
    Dim X As Long, Seller As Variant
    Seller = RangeRowColumns(Selection)
    For X = Val(Seller(4)) To Val(Seller(2)) Step -1
          If Cells(X, Seller(1)).Font.ColorIndex = 5 Or _
          Cells(X, Seller(1)).Font.ColorIndex = 3 Then
          Rows(Cells(X, Seller(1)).Row).Delete
        End If
    Next
End Sub

Function RangeRowColumns(rtest As Range) As Variant
    Dim st As String
    Dim X As Integer
    st = rtest.Address
    st = Replace(st, ":", "")
    RangeRowColumns = Split(st, "$")
End Function

Nu kan den klare området Fra A til Z

Sub DeleteRedAndBlueRows()
    Dim X As Long, Y As Integer, Seller As Variant
    Seller = RangeRowColumns(Selection)
    For Y = Asc(Seller(1)) - 64 To Asc(Seller(3)) - 64
    For X = Val(Seller(4)) To Val(Seller(2)) Step -1
          If Cells(X, Y).Font.ColorIndex = 5 Or _
          Cells(X, Y).Font.ColorIndex = 3 Then
          Rows(Cells(X, Seller(1)).Row).Delete
        End If
    Next
    Next
End Sub

Function RangeRowColumns(rtest As Range) As Variant
    Dim st As String
    Dim X As Integer
    st = rtest.Address
    st = Replace(st, ":", "")
    RangeRowColumns = Split(st, "$")
End Function

en lille rettelse til den første.

Sub DeleteRedAndBlueRows()
    Dim X As Long, Y As Integer, Seller As Variant
    Seller = RangeRowColumns(Selection)
    For Y = Asc(Seller(1)) - 64 To Asc(Seller(3)) - 64
    For X = Val(Seller(4)) To Val(Seller(2)) Step -1
          If Cells(X, Y).Font.ColorIndex = 5 Or _
          Cells(X, Y).Font.ColorIndex = 3 Then
          Rows(Cells(X, Y).Row).Delete
        End If
    Next
    Next
End Sub

Ja, der må gerne sorteres - rækkernes rækkefølge er ligegyldig. (I øvrigt er jeg IMPONERET over så hurtige kommentarer/løsninger! Jeg vil afprøve det straks i morgen.

Btw: er der et "manuelt" alternativ til koden, altså fx : 1)vælg alle rækker, 2) klik xx og vælg yy, 3)???

Nu er koden ændret, så hvis du kun aktivere 1 celle, vil den vælge hele dataområdet fra A1 af, ellers kører den det du har markeret.


Sub DeleteRedAndBlueRows()
    Dim X As Long, Y As Integer, Seller As Variant
    If Selection.Cells.Count = 1 Then Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Select
    Seller = RangeRowColumns(Selection)
    For Y = Asc(Seller(1)) - 64 To Asc(Seller(3)) - 64
    For X = Val(Seller(4)) To Val(Seller(2)) Step -1
          If Cells(X, Y).Font.ColorIndex = 5 Or _
          Cells(X, Y).Font.ColorIndex = 3 Then
          Rows(Cells(X, Y).Row).Delete
        End If
    Next
    Next
End Sub

Det virker ski da! :-) Kan jeg skrive noget i stil med "If Cells(X, Y).Font.ColorIndex <> vbBlack" i stedet for den kontrol, du foreslår?

If Cells(X, Y).Font.ColorIndex <> xlAutomatic Then

skal det være

SUPER!

Hmm, har jeg fået lukket korrekt af og givet point?

nej, du skal markere mit navn i boksen til venstre og så tryk accepter

Tak :-)

tak for point ;-))