• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excel vba makro yardım edin lütfen !!

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Katılım
14 Aralık 2017
Mesajlar
2
Excel Vers. ve Dili
2016-Türkçe
Merhaba arkadaşlar Execl de makrolara yeni başladım ve şöyle bir makro oluşturmam lazım ama yapamıyorum ve sizden yardım istiyorum.

Aşağıdaki gibi bir ekran tanımlayalım.


Buna göre “KODU ÇALIŞTIR” butonuna basıldığında B kolonundaki sayıları kontrol etsin, tek sayıları sarı, çift sayıları da kırmızı renge boyasın



Sayı eklenince veya çıkarılınca da işlem yapabilsin

 
Aşağıdaki kodları deneyiniz:

Kod:
Sub renk()
son = WorksheetFunction.Max(3, Cells(Rows.Count, "B").End(3).Row)
Range("B3:B" & son).Interior.Color = xlNone
For i = 3 To son
    If Cells(i, "B") Mod 2 = 0 Then
        Cells(i, "B").Interior.Color = vbRed
    Else
        Cells(i, "B").Interior.Color = vbYellow
    End If
Next
End Sub
 
Merhaba,
Makro ile Çift ve Tek sayıları renklendirmek için şu kodları kullanabilirsiniz.
Kod:
Sub tek_cift()
Application.ScreenUpdating = False
Range("B3:B" & Range("B65536").End(3).Row).Interior.ColorIndex = xlNone
For x = 3 To Range("B" & Rows.Count).End(3).Row
    If WorksheetFunction.IsEven(Cells(x, "B")) Then
        Cells(x, "B").Interior.ColorIndex = 3
    Else
        Cells(x, "B").Interior.ColorIndex = 6
    End If
    If Cells(x, "B") = "" Then Cells(x, "B").Interior.ColorIndex = xlNone
Next
Application.ScreenUpdating = True
End Sub
İyi çalışmalar.
Not: Yusuf Bey'in paylaşımını, mesajı gönderince gördüm. Alternatif olarak bu kodları kullanabilirsiniz.
 
Son düzenleme:
Geliştirici sekmesinden Bir Active X denetimli buton koyun ve içine bu kodları yazın. Ben burada B hücresini esas aldım. Eğer hücreyi değiştirirseniz kodları da ona göre uyarlayın.

Kod:
Private Sub CommandButton1_Click()
Dim ilk As Integer, son As Integer
Dim v As Integer, yer As Integer
Dim y As Integer
Dim a As Variant, b As Integer

ilk = Range("B1").End(4).Row
son = Range("B" & Rows.Count).End(xlUp).Row

yer = ilk

    For v = 2 To son
    a = Range("B" & yer) / 2
    b = Int(a)
    If a = b Then
    Range("B" & yer).Interior.ColorIndex = 3
    yer = yer + 1
Else
    Range("B" & yer).Interior.ColorIndex = 6
    yer = yer + 1
End If
    Next v

End Sub
 
Cevaplarınız için teşekkür ederim işime yaradı.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst