renkli satır silme

[tkcargo]

arkadaşlar merhaba
bana A sutununda kırmızı renkli hucrelerin bulunduğu satırı komple silecek bi makro lazım
arama yaptım şöyle bi makro buldum ama işe yaramadı

Sub SnipSingleCornerRectangle2_Click()
For X = [a65536].End(3).Row To 3 Step -1
If Cells(X, 1).Font.ColorIndex = 3 Then Rows(X).Delete 3
Next X
End Sub

 

[fireman64]

Aşağıdaki kodu comandbutton a atayarak deneyiniz.
Option Explicit

Sub commandbutton1_click()
Dim SAYFA As Worksheet, X As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each SAYFA In ThisWorkbook.Worksheets
With SAYFA
For X = .Cells(Rows.Count, "A").End(3).Row To 1 Step -1
If .Cells(X, "A").Interior.ColorIndex = 3 Then
.Rows(X).Delete
End If
Next
End With
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Seyit Tiken]

Dolgu rengini mi silmek istiyorsunuz?

 

[tkcargo]

maalesef bi değişiklik olmadı
hayır dolgu değil font rengini silmek istiyorum daha doğrusu herhangi bir hücrede font rengi kırmızı olan satırları silmek istiyorum

 

[Seyit Tiken]

Kodunuz çalışıyor, denediniz mi?
Bu şekide düğmeye atıp deneyiniz.

For x = [a65536].End(3).Row To 3 Step -1
If Cells(x, 1).Font.ColorIndex = 3 Then Rows(x).Delete 
Next x

 

[fireman64]

bana A sutununda kırmızı renkli hucrelerin bulunduğu satırı komple silecek bi makro lazım

aşağıdaki kodu deneyiniz
Sub commandbutton1_click()
Dim SAYFA As Worksheet, X As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each SAYFA In ThisWorkbook.Worksheets
With SAYFA
For X = .Cells(Rows.Count, "A").End(3).Row To 1 Step -1
If .Cells(X, "A").Font.ColorIndex = 3 Then
.Rows(X).Delete
End If
Next
End With
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tkcargo]

dosyayı ekledim calışmıyor birde siz bakarmısınız

 

[Seyit Tiken]

2003 olarak kaydedip siteye yükleyiniz.

 

[tkcargo]

tamamdır tekrar yükledim

 

[Seyit Tiken]

Dosyanızda gördüğünüz kırmızı hücreler(font), Koşullu Biçimlendirme ile yapılmış, onu silip düzeltirseniz, kod çalışır.

 

[tkcargo]

ama başka yolu yokmu o sutunda koşullu biçimlendirme şart benim için
6 ile baslayan rakamların renkli olması lazımki onları silebiliyim

 

[tkcargo]

yada a sutununda 6000 ve daha buyuk deger varsa satırı silen bir makroda olabilir

 

[Seyit Tiken]

Bu şekilde deneyiniz.

For i = [A65536].End(3).Row To 1 Step -1
If Cells(i, "A") >= 6000 Then Cells(i, "A").Rows.Delete 3
Next i

 

[tkcargo]

sn Seyit Tiken sorun cozuldu tesekkurler