Makro renklendirme

[sinan tek]

merhaba arkadaşlar mesela a stunundaki sayıları renklendirmek istiyorum.

çıtır hocaya teşekkürler.

 

[çıtır]

Sayın Sinan tek önçelikle foruma hoş geldiniz.Şöyle bir kod yazdım.İnşaallah işinizi görür.Kolay gelsin.

Sub renklendir()
Dim i As Integer
 For i = 1 To Cells(65536, "A").End(3).Row
 On Error Resume Next
If Sheets("Sayfa1").Range("A" & i).Value = WorksheetFunction.Odd(Sheets("Sayfa1").Range("A" & i)) Then
Sheets("Sayfa1").Range("A" & i).Font.ColorIndex = 11
ElseIf Sheets("Sayfa1").Range("A" & i).Value = WorksheetFunction.Even(Sheets("Sayfa1").Range("A" & i)) Then
Sheets("Sayfa1").Range("A" & i).Font.ColorIndex = 3
 End If
 Next i
End Sub

 

[sinan tek]

Sayın Sinan tek önçelikle foruma hoş geldiniz.Şöyle bir kod yazdım.İnşaallah işinizi görür.Kolay gelsin.

Sub renklendir()
 Dim rng As Range
 Dim i As Integer
 For i = 1 To Cells(65536, "A").End(3).Row
 For Each rng In Range("A" & i & ":" & "A" & i)
 
On Error Resume Next
If rng.Value = WorksheetFunction.Odd(Sheets("Sayfa1").Range("A" & i)) Then
rng.Font.ColorIndex = 11
ElseIf rng.Value = WorksheetFunction.Even(Sheets("Sayfa1").Range("A" & i)) Then
rng.Font.ColorIndex = 3
 End If
 Next rng
 Next i
End Sub

çok teşekkürler arka planı yanı sutunu renklendirmek için .font silmekmi lazım fontu değilde arkasını ?

birde

Sub topla()
Dim i As Long, tpl As Double
For i = 1 To 10
tpl = tpl + Cells(i, "A").Value
Next
Range("B11").Value = tpl
End Sub


böyle bir şey yazdım topluyor ama 1-10 arasını. ben bunu nasıl sayı değeri olmadan 10 olmadan kaç tane varsa o kadar toplasın a bölümünde mesela yaparım ?

 

[çıtır]

Dolgu rengi için ve aynı komutlar kopyalayınız dolgu rengi de ınteriorla başka renk belirleyiniz.
font siliniz ve Interior yazınız
10 siliniz ve yerine aşağıdaki kodu yazınız.
Cells(65536, "A").End(3).Row

 

[çıtır]

Sub renklendir()
Dim i As Integer
 For i = 1 To Cells(65536, "A").End(3).Row
 On Error Resume Next
If Sheets("Sayfa1").Range("A" & i).Value = WorksheetFunction.Odd(Sheets("Sayfa1").Range("A" & i)) Then
Sheets("Sayfa1").Range("A" & i).Interior.ColorIndex = 11
Sheets("Sayfa1").Range("A" & i).Font.ColorIndex = 3
ElseIf Sheets("Sayfa1").Range("A" & i).Value = WorksheetFunction.Even(Sheets("Sayfa1").Range("A" & i)) Then
Sheets("Sayfa1").Range("A" & i).Interior.ColorIndex = 3
Sheets("Sayfa1").Range("A" & i).Font.ColorIndex = 8
 End If
 Next i
End Sub

 

[sinan tek]

Sub renklendir()
Dim i As Integer
 For i = 1 To Cells(65536, "A").End(3).Row
 On Error Resume Next
If Sheets("Sayfa1").Range("A" & i).Value = WorksheetFunction.Odd(Sheets("Sayfa1").Range("A" & i)) Then
Sheets("Sayfa1").Range("A" & i).Interior.ColorIndex = 11
Sheets("Sayfa1").Range("A" & i).Font.ColorIndex = 3
ElseIf Sheets("Sayfa1").Range("A" & i).Value = WorksheetFunction.Even(Sheets("Sayfa1").Range("A" & i)) Then
Sheets("Sayfa1").Range("A" & i).Interior.ColorIndex = 3
Sheets("Sayfa1").Range("A" & i).Font.ColorIndex = 8
 End If
 Next i
End Sub

teşekkürler yardımınız için

 

[çıtır]

teşekkürler yardımınız için

Rica ederim.Dönüş yaptığınız için teşekkür ederim.Kolay gelsin.

 

[çıtır]

B1 toplar .B2 ortalama

Sub topla()
Dim son As Integer
son = Cells(65536, "A").End(3).Row
Sheets("Sayfa1").Range("b1").Value = WorksheetFunction.Sum(Sheets("Sayfa1").Range("A1:a" & son))
Sheets("Sayfa1").Range("b2").Value = WorksheetFunction.Average(Sheets("Sayfa1").Range("A1:A" & son))
End Sub

 

[çıtır]

Boş ve metinleri işleme almaz.

Sub renklendir()
 Dim rng As Range
 Dim i As Integer
 t = Cells(65536, "A").End(3).Row
 Sheets("Sayfa1").Range("A1:A" & t).Select
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = xlNone
 Range("B1").Select
 For i = 1 To Cells(65536, "A").End(3).Row
 For Each rng In Range("A" & i)
 t = WorksheetFunction.Count(Sheets("Sayfa1").Range("A" & i))
If t > 0 Then
If rng.Value = WorksheetFunction.Odd(Sheets("Sayfa1").Range("A" & i)) Then
rng.Font.ColorIndex = 3
rng.Interior.ColorIndex = 11
ElseIf rng.Value = WorksheetFunction.Even(Sheets("Sayfa1").Range("A" & i)) Then
rng.Font.ColorIndex = 8
rng.Interior.ColorIndex = 3
End If
 End If
 Next rng
 Next i
End Sub