Sarı renkli hücreleri silmek

[cavanoos]

Merhaba arkadaşlar;

Ekli örnek dosyamda sarı renkli hücreler var.İçinde değerler var.Sayfa içindeki sarı renkli hücrelerin içerisini temizlemek istiyorum.Bu şekilde 5000 kadar hücre var.Bu işlemi bir makro koduna bağlayabilir miyiz ?

 

[İhsan Tank]

Merhaba arkadaşlar;

Ekli örnek dosyamda sarı renkli hücreler var.İçinde değerler var.Sayfa içindeki sarı renkli hücrelerin içerisini temizlemek istiyorum.Bu şekilde 5000 kadar hücre var.Bu işlemi bir makro koduna bağlayabilir miyiz ?

merhaba
boş bir module kopyalayınız

Option Explicit
Sub sarıları_sil()
Dim ts, kaplan
kaplan = MsgBox("Sarıları Temizliyorum", vbYesNo, "Onay")
Application.ScreenUpdating = False
For ts = 1 To Cells(65536, "A").End(xlUp).Row
If Cells(ts, "A").Interior.ColorIndex = 6 Then
Cells(ts, "A").ClearContents
End If
If Cells(ts, "B").Interior.ColorIndex = 6 Then
Cells(ts, "B").ClearContents
End If
If Cells(ts, "C").Interior.ColorIndex = 6 Then
Cells(ts, "C").ClearContents
End If
Next
Application.ScreenUpdating = True
MsgBox "Sarıları Temizledim", vbInformation, "Bitiş"
End Sub

 

[Necdet]

Merhaba,

Alternetaf, Önce genel olarak seçin sonra aşağıdaki kodları çalıştırın.

Sub Sari_Renkli_Hucreleri_Sil()
    Dim hucre As Range
    
    For Each hucre In Selection
        If hucre.Interior.ColorIndex = 6 Then hucre.ClearContents
    Next hucre
    
End Sub

 

[Seyit Tiken]

Bu şekilde deneyiniz.

Sub sarıhucrelerisil()
Application.FindFormat.Interior.ColorIndex = 6
[a1:c200].Replace What:="", Replacement:="", SearchFormat:=True
End Sub

 

[cavanoos]

Arkadaşlar;

İlgilendiğiniz için teşekkür ederim.Sorunum çözülmüştür.Allah sizden razı olsun...

 

[İhsan Tank]

Arkadaşlar;

İlgilendiğiniz için teşekkür ederim.Sorunum çözülmüştür.Allah sizden razı olsun...

rica ederim
Syn : Necdet Hocam'a ve Syn : Seyit Tiken Bey'e teşekkür ederim
:yazici:

 

[cavanoos]

Merhaba arkadaşlar;

Sarı renkli hücreleri temizledikten sonra yerine 0 değeri yazmamız için hangi kodu kullanmalıyız ?

 

[Necdet]

Merhaba,
Deneyiniz.

Sub Sari_Renkli_Hucreleri_Sil()

    Dim hucre As Range
    
    For Each hucre In ActiveSheet.UsedRange
        If hucre.Interior.ColorIndex = 6 Then hucre = 0
    Next hucre
    
End Sub

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Replace_Yellow_Cells()
    With Application
        .ScreenUpdating = False
        .FindFormat.Clear
        .FindFormat.Interior.ColorIndex = 6
    End With
    Cells.Replace What:="*", Replacement:=0, SearchFormat:=True
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[cavanoos]

Oldu, teşekkür ederim.