Fazla olan değerleri bulacak makro.

[ahzola]

Merhabalar.

A sütununu süzecek ve
En fazla İsim kimse o ismin karşısına B sütununa "ok" yazacak.
Diğer isimlerin karşısına yine B sütununa "mesai" ye gelecek yazacak.

yardımlarınızı bekliyorum.

saygılarımla.

 

[Orion1]

Dosyanız ektedir.

Sub mesai59()
Dim i As Long, sat As Long, say As Long, k As Range, adr As String
sat = Cells(Rows.Count, "A").End(xlUp).Row
Range("B:B").ClearContents
Range("A4:B" & sat).Font.ColorIndex = 0
Application.ScreenUpdating = False

Range("B4:B" & sat).Value = "Mesai"
For i = 4 To sat
    say = WorksheetFunction.CountIf(Range("A4:A" & sat), Cells(i, "A").Value)
    If say > cok Then cok = say: deg = Cells(i, "A").Value
    
Next i
Set k = Range("A4:A" & sat).Find(deg, , xlValues, , xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        Cells(k.Row, "B").Value = "Ok"
        Range("A" & k.Row).Font.ColorIndex = 3
        Range("B" & k.Row).Font.ColorIndex = 3
        Set k = Range("A4:A" & sat).FindNext(k)
        
    Loop While adr <> k.Address And Not k Is Nothing
End If
Application.ScreenUpdating = True
End Sub

 

[ahzola]

Ellerinize sağlık.
Sayın Orion

Çok teşekkür ediyorum.
Herşey gönlünüzce olsun.

 

[ahzola]

Dosyanız ektedir.

Sub mesai59()
Dim i As Long, sat As Long, say As Long, k As Range, adr As String
sat = Cells(Rows.Count, "A").End(xlUp).Row
Range("B:B").Clear
Range("A4:A" & sat).Font.ColorIndex = 0
Application.ScreenUpdating = False

Range("B4:B" & sat).Value = "Mesai"
For i = 4 To sat
    say = WorksheetFunction.CountIf(Range("A4:A" & sat), Cells(i, "A").Value)
    If say > cok Then cok = say: deg = Cells(i, "A").Value
    
Next i
Set k = Range("A4:A" & sat).Find(deg, , xlValues, , xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        Cells(k.Row, "B").Value = "Ok"
        Range("A" & k.Row).Font.Color = vbRed
        Range("B" & k.Row).Font.Color = vbRed
        Set k = Range("A4:A" & sat).FindNext(k)
        
    Loop While adr <> k.Address And Not k Is Nothing
End If
Application.ScreenUpdating = True
End Sub

Herkese Günaydın.
İyi Pazarlar dilerim.

Makromuz sorunsuz çalışıyor lakin küçük bir düzeltme istiyorum.
Daha önceden biçimlediğim hücreyi değiştiriyor.

Örneğin ben Bu makronun yazacağı hücreyi text ten center(ortala) dememe ragmen
verileri sağa hizalıyor.

Buna sebep olan şey makronun içindemi tanımlandı acaba?
Çünkü başka makrolarda bahsettiğim sorunu yaşamıyorum.

Yardımlarınızı bekliyorum.

 

[Ziynettin]

Merhaba,
Ortalanması istediğiniz sutun hangisi?

 

[ahzola]

Merhaba

Ortalamasını istediğim sütun B sütunu.

Daha önceden B sütununu ortalama olarak biçimlendirdiğim halde
sağa yada sola hizalı olarak verileri yazıyor.

Ek olarak K harfi geçiyor sürekli makroda
tam olarak işlevi nedir bu K harfinin nın bunun malumatıda faydalı olacaktır benim için.

teşekkür ederim.

 

[Orion1]

Merhaba

Ortalamasını istediğim sütun B sütunu.

Daha önceden B sütununu ortalama olarak biçimlendirdiğim halde
sağa yada sola hizalı olarak verileri yazıyor.

Ek olarak K harfi geçiyor sürekli makroda
tam olarak işlevi nedir bu K harfinin nın bunun malumatıda faydalı olacaktır benim için.

teşekkür ederim.

Dosyanız 2 nolu mesajda tekrar güncelledim.
k hücre aralığı tanımlanan bir değişkendir.

 

[ahzola]

Değerli Uzman arkadaşlar.

2 Nolu mesajdaki makromuza küçük bir revizyon istemekteyim.

* Makro veri yazdığı yerdeki biçimlendirmeyi bozmakta
(metin ortalaması yazı büyüklüğü gibi)

** İkinci bir ilave ise renk olayı.
Makromuzda renk yazı ile tanımlanmış ve Kırmızı renk atanmış.
bunu renk kodu ile tanımlanmasını istiyorum.

saygılarımla.

 

[Orion1]

7 numaralı mesajı okuyunuz.

 

[ahzola]

Aynı anda yazılmış mesajlar

Sayın Orion

Değerli Üstad ne kadar teşekkür etsem azdır.

Saygılar sunuyorum:dua2::dua2:.