DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Kalın fontlu cümlem için bir bildirim yapmamışsınız..Merhaba,
Mesajınızda iki çelişkili ifade kullanmışsınız..
"hücre renkli ise sıfır yazmasını istiyorum."
"dolgu olmayan hücreye nasıl sıfır yazdırabilirim."
Burada önemli olan hücrelerin rengi nasıl aldığıdır.. Elle ya da koşullu biçimlendirme durumuna göre kod yazılabilir..
Option Explicit
Sub Write_Zeros_In_Colored_Cells()
Dim My_Area As Range, Rng As Range
Set My_Area = Range("A1:Z1000")
My_Area.ClearContents
For Each Rng In My_Area
If Rng.Interior.ColorIndex <> xlNone Then
Rng.Value = 0
End If
Next
MsgBox "Renkli hücrelere sıfır yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub
If Rng.Interior.ColorIndex <> xlNone Then
Rng.Value = 0
Else
Rng.Value = 1
End If
Korhan Bey MerhabaAşağıdaki kod tanımlı alan içindeki verileri önce temizler sonra renkli hücrelere sıfır yazar.
Kullanım durumunuza göre revize edebilirsiniz.
C++:Option Explicit Sub Write_Zeros_In_Colored_Cells() Dim My_Area As Range, Rng As Range Set My_Area = Range("A1:Z1000") My_Area.ClearContents For Each Rng In My_Area If Rng.Interior.ColorIndex <> xlNone Then Rng.Value = 0 End If Next MsgBox "Renkli hücrelere sıfır yazdırma işlemi tamamlanmıştır.", vbInformation End Sub
Option Explicit
Sub Write_Zeros_In_Colored_Cells()
Dim My_Area As Range, Rng As Range
Set My_Area = Range("A1:Z1000")
My_Area.ClearContents
For Each Rng In My_Area
If Rng.DisplayFormat.Interior.ColorIndex <> xlNone Then
Rng.Value = 0
End If
Next
MsgBox "Renkli hücrelere sıfır yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub
Teşekkürler Korhan BeyAşağıdaki gibi deneyiniz.
C++:Option Explicit Sub Write_Zeros_In_Colored_Cells() Dim My_Area As Range, Rng As Range Set My_Area = Range("A1:Z1000") My_Area.ClearContents For Each Rng In My_Area If Rng.DisplayFormat.Interior.ColorIndex <> xlNone Then Rng.Value = 0 End If Next MsgBox "Renkli hücrelere sıfır yazdırma işlemi tamamlanmıştır.", vbInformation End Sub