RENKLİ DOLU VE BOŞ HÜCRE VE RENK SAYILARI

RENKLİ DOLU VE BOŞ HÜCRE VE RENK SAYILARI

Renkli boş ve dolu hücrelerin renk sayılarını bulmak için aşağıdaki makrolar kullanılmıştır.

Sub RenkliDoluRenkleri()
Dim c As Range
Dim J As Integer
Dim Rsayi(56) As Long

ActiveSheet.Range(“a1″).CurrentRegion.SpecialCells(xlCellTypeConstants).Select

For Each c In Selection
With c.Interior
If .Pattern <> xlNone Then
If .ColorIndex <> xlNone Then

Rsayi(.ColorIndex) = _
Rsayi(.ColorIndex) + 1

End If
End If
End With
Next c

sonuc = “Renkli Dolu Hücreler Renk Sayıları:” & vbCrLf & vbCrLf
For J = 0 To 56
If Rsayi(J) > 0 Then
sonuc = sonuc & “Renk ” & J & “: ” & Rsayi(J) & vbCrLf
End If
Next J

MsgBox sonuc
End Sub

Sub RenklibosRenkleri()

Dim c As Range
Dim J As Integer
Dim Rsayi(56) As Long

ActiveSheet.Range(“a1″).CurrentRegion.SpecialCells(xlCellTypeBlanks).Select

For Each c In Selection
With c.Interior
If .Pattern <> xlNone Then
If .ColorIndex <> xlNone Then
If IsEmpty(c) Then
Rsayi(.ColorIndex) = _
Rsayi(.ColorIndex) + 1
End If
End If
End If
End With
Next c

sonuc = “Renkli Boş Hücreler Renk Sayıları:” & vbCrLf & vbCrLf
For J = 0 To 56
If Rsayi(J) > 0 Then
sonuc = sonuc & “Renk ” & J & “: ” & Rsayi(J) & vbCrLf
End If
Next J

MsgBox sonuc

End Sub

Sub RenkliDolu()

Dim c As Range
Dim x As Long

x = 0
ActiveSheet.Range(“A1″).CurrentRegion.SpecialCells(xlCellTypeConstants).Select

For Each c In Selection
If c.Interior.Pattern <> xlNone Then
If c.Interior.ColorIndex <> xlNone Then
If Not IsEmpty(c) Then x = x + 1
End If
End If
Next c
MsgBox “Renkli Dolu Hücre Sayısı: ” & x

End Sub

 
Sub Renklibos()

Dim c As Range
Dim x As Long

x = 0
ActiveSheet.Range(“A1″).CurrentRegion.SpecialCells(xlCellTypeBlanks).Select

For Each c In Selection
If c.Interior.Pattern <> xlNone Then
If c.Interior.ColorIndex <> xlNone Then
If IsEmpty(c) Then x = x + 1
End If
End If
Next c
MsgBox “Renkli Bos Hücre Sayısı: ” & x

End Sub

Dosya:

Hücrerenksay