Dolgu rengi siyah olanların içeriğini silmek.

[Leoncio]

Arkadaşlar merhaba;

Aşağıdaki kodlar ile dolgu rengi siyah olan satırları sildirebiliyorum.
Peki satıra dokunmadan dolgu rengi siyah olan hücrelerin içeriğini sildirebilirmiyim?
(Kullandığım tablolarda dolgu rengi siyah olanların içeriğinde bazen 0 (sıfırlar) olabiliyor.
Bunları silmek istiyorum. Her tabloda yerleri ayni değil)

Sub renklisatirsil()
Dim hucre, a As Integer
a = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
For hucre = a To 1 Step -1
If Cells(hucre, 1).Interior.ColorIndex = 1 Then
Cells(hucre, 1).EntireRow.Delete
End If
Next
End Sub

 

[Kemal Demir]

Zannedersem Aşagıdaki Kod işinizi görür.

A kolonu için geçerlidir.

Sub siyahsil()
For x = 2 To [a65536].End(3).Row
    If Cells(x, 1).Interior.ColorIndex = 1 Then
    Range("a" & x).ClearContents
End If
Next

End Sub

 

[Merhum İdris SERDAR]

Cells(hucre, 1).EntireRow.Delete

Satırını

Cells(hucre, 1).EntireRow.ClearContents

şeklinde değiştirin.

 

[alpi]

Ctrl+H ye basın sonrada seçenekler i tıklatın kod yazmanıza gerek yok.

 

[Leoncio]

Merhaba;
Konuya ilişkin örnek dosya ekte..Maalesef her iki kodda istediğimi yapmıyor.

Sayin Alpi Ctrl+H seçeneklerden nasıl yapacağız bu işi..

 

[alpi]

Ctrl+H ye basın Seçenkleri tuklatın

Aranan değer için Biçim i tıklatın Desenler tabından Renk olarak Siyah ı seçin Tamam ı tıklatın En son Tümünü değiştir i tıklatın

 

[Erkan Akayay]

Sub Temizle()
Dim hucre As Range
For Each hucre In ActiveSheet.UsedRange
If hucre.Interior.ColorIndex = 1 Then
hucre.ClearContents
End If
Next
End Sub

 

[Leoncio]

Sn. Erkan Akayay;

Kodlar için teşekkür ederim.

 

[kemal0618]

peki örnekteki sarı dolgulu ve hücre içi değeri 8 olanları sil sadece deseydik macro kodumuz ne olurdu üstadlarım tesekkur ederım emeklerinize.

 

[byfika]

Deneyiniz,

Sub Dene1() 'Hücre içi hem 8 ve hemde arka planları sarı ise hücre içeriğini siler
For x = 2 To [a65536].End(3).Row
If Cells(x, 1) = 8 And Cells(x, 1).Interior.ColorIndex = 6 Then
Range("a" & x).ClearContents
End If
Next
End Sub

Sub Dene2() 'Hücre içi 8 ve arka planları sarı olanların içini siler
For x = 2 To [a65536].End(3).Row
If Cells(x, 1) = 8 Then
Range("a" & x).ClearContents
End If
If Cells(x, 1).Interior.ColorIndex = 6 Then
Range("a" & x).ClearContents
End If
Next
End Sub

 

[kemal0618]

Deneyiniz,

Sub Dene1() 'Hücre içi hem 8 ve hemde arka planları sarı ise hücre içeriğini siler
For x = 2 To [a65536].End(3).Row
If Cells(x, 1) = 8 And Cells(x, 1).Interior.ColorIndex = 6 Then
Range("a" & x).ClearContents
End If
Next
End Sub

Sub Dene2() 'Hücre içi 8 ve arka planları sarı olanların içini siler
For x = 2 To [a65536].End(3).Row
If Cells(x, 1) = 8 Then
Range("a" & x).ClearContents
End If
If Cells(x, 1).Interior.ColorIndex = 6 Then
Range("a" & x).ClearContents
End If
Next
End Sub

çok tesekkur ederım sadece 1.sini denedim çalıştı evet fakat tabloda istediğim birden fazla sütun oldugunda ne yapabilirim.
ben bunu denedim olmadı hepsını sildi;

Sub Dene1() 'Hücre içi hem 8 ve hemde arka planları sarı ise hücre içeriğini siler
For x = 2 To [a65536].End(3).Row
If Cells(x, 1) = 8 And Cells(x, 1).Interior.ColorIndex = 6 Then
Range("a2:c11" & x).ClearContents
End If
Next
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Range("A2:C100") aralığını ihtiyacınıza göre revize edebilirsiniz. O bölüme Selection yazarsanız mouse ile seçtiğiniz hücrelerde kod çalışacaktır.

Option Explicit

Sub Cells_ClearContents()
    Dim Rng As Range
    
    Application.ScreenUpdating = False
    
    For Each Rng In Range("A2:C100")
        If Rng.Value = 8 And Rng.Interior.ColorIndex = 6 Then Rng.ClearComments
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kemal0618]

Deneyiniz.

Range("A2:C100") aralığını ihtiyacınıza göre revize edebilirsiniz. O bölüme Selection yazarsanız mouse ile seçtiğiniz hücrelerde kod çalışacaktır.

Option Explicit

Sub Cells_ClearContents()
    Dim Rng As Range
   
    Application.ScreenUpdating = False
   
    For Each Rng In Range("A2:C100")
        If Rng.Value = 8 And Rng.Interior.ColorIndex = 6 Then Rng.ClearComments
    Next
   
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Süpersiniz üstadlar iyiki varsınız.? Hayırli güzel mutlu bayramlar dilerim.