Yinelenen değerlerden kırmızı renkte olanları silme

[ysno]

Merhaba,

Excelde kırmızı ve siyah renkte yinelenen değerlerim var. Yinelenen yazı rengi hem kırmızı hem siyah renkte. Bunlardan sadece kırmızı yinelenenleri silip siyah olanlar kalsın istiyorum nasıl yapabilirim. Bununla ilgili bir makro varmı? Yinelenen tüm kırmızılar silinecek. Yardımcı olabilir misiniz?

 

[ysno]

https://imgyukle.com/i/kqLWwx linkte örnek tablo var. Yinelenen değer hem kırmızı hem siyah renkte bunlardan kırmızıları sileceğim.

 

[ÖmerFaruk]

Tüm kırmızı satırlar silinecek diyebilir miyiz?

 

[ysno]

Tüm kırmızı satırlar silinecek diyebilir miyiz?

evet ama yinelenmeyen kırmızılarda var onlar silinmeyecek. B sütununa göre yapabilir miyiz? mesela 3 adet 001-01-02-0126 var. birisi siyah renk, 2 si kırmızı renk. Bunların kırmızıları silinecek siyah olan kalacak.

 

[ÖmerFaruk]

Aşağıdaki kodu sayfanızda çalıştırın.

Sub TekrarlananKırmızı()
    son = Range("B12").End(xlDown).Row
    For i = son To 12 Step -1
        If WorksheetFunction.CountIf(Range("B12:B" & son), Range("B" & i)) > 0 Then
            If Range("B" & i).Font.Color = vbRed Then Rows(i).Delete
        End If
    Next i
End Sub

 

[veyselemre]

Sub TEST()
    Dim rng As Range, cell As Range, silRng As Range
    Set rng = Range("B12", Cells(Rows.Count, 2).End(3))
    For Each cell In rng
        If cell.Font.Color = vbRed Then
            If WorksheetFunction.CountIf(rng, cell.Value) > 1 Then
                If silRng Is Nothing Then
                    Set silRng = cell.EntireRow
                Else
                    Set silRng = Union(silRng, cell.EntireRow)
                End If
            End If
        End If
    Next cell
    If Not silRng Is Nothing Then silRng.Delete
End Sub

 

[ysno]

Aşağıdaki kodu sayfanızda çalıştırın.

Sub TekrarlananKırmızı()
    son = Range("B12").End(xlDown).Row
    For i = son To 12 Step -1
        If WorksheetFunction.CountIf(Range("B12:B" & son), Range("B" & i)) > 0 Then
            If Range("B" & i).Font.Color = vbRed Then Rows(i).Delete
        End If
    Next i
End Sub

Bu kod tekrar etmeyen kırmızılarıda sildi.

 

[ysno]

Sub TEST()
    Dim rng As Range, cell As Range, silRng As Range
    Set rng = Range("B12", Cells(Rows.Count, 2).End(3))
    For Each cell In rng
        If cell.Font.Color = vbRed Then
            If WorksheetFunction.CountIf(rng, cell.Value) > 1 Then
                If silRng Is Nothing Then
                    Set silRng = cell.EntireRow
                Else
                    Set silRng = Union(silRng, cell.EntireRow)
                End If
            End If
        End If
    Next cell
    If Not silRng Is Nothing Then silRng.Delete
End Sub

Teşekkür ederim. İstediğim sonucu verdi

 

[ysno]

Bir sorum daha olacak. Address sekmesine tıkladığımda 4 sütunu birden kapsadığı için diğer sütunları silmem gerekiyor makronun çalışması için. Bu sütunlarıda kapsayacak şekilde makro düzeltilebilir mi? Yoksa her seferinde diğer sütunları silerek mi yapmak gerekecek? Linkte sütuna tıkladığımda B-C-D-E sütunlarının hepsini seçtiğini gösteren görsel var.

Örnek Görsel: https://imgyukle.com/i/kq93WU

 

[ysno]

Birde bu makroyu daha sonra aynı formatta farklı bir excelde kullanabilmek için hazır hale nasıl getirebilirim. Her seferinde makro oluştur deyip kod yazmadan?