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