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:
Son Yorumlar