• DİKKAT

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

mükerrerler gruplarda maxsimum değerleri bulmak

numan şamil

Destek Ekibi
Destek Ekibi
Katılım
27 Ocak 2011
Mesajlar
1,238
Excel Vers. ve Dili
Ofis 2013 Türkçe
Merhaba Arkadaşlar
Mükerrer gruplara ait rakamlarda maxsimum değerleri bulmak istiyorum
ekli dosyada olduğu gibi
 

Ekli dosyalar

Merhaba

Bunu deneyiniz.
Kod:
=(EĞERSAY($A$2:$A$14;$A2)=EĞERSAY($A$2:$A2;$A2))*(TOPLA.ÇARPIM(MAK(($A$2:$A$14=$A2)*($B$2:$B$14))))
 
çalışmama adepte için malesef makrolu gerekiyor
 
Merhaba,


C++:
Sub MaxDegerBul()
    Dim lRow, i, say, say2 As Integer
    Dim ws As Worksheet
    
    Set ws = Sheets("Sayfa1")
    lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lRow  'Birden fazla maksimum değerin hepsini (C sütununa) yazdırır.
        ws.Range("C" & i).FormulaArray = "=Max(If(Sayfa1!A2:A" & lRow & "=A" & i & ", Sayfa1!B2:B" & lRow & "))"
        If ws.Range("C" & i) <> ws.Range("B" & i) Then ws.Range("C" & i) = ""
    Next i
    
    For i = 2 To lRow   'Birden fazla maksimum değerin ilk buluduğunu (D sütununa) yazdırır.
        ws.Range("D" & i).FormulaArray = "=Max(If(Sayfa1!A2:A" & lRow & "=A" & i & ", Sayfa1!B2:B" & lRow & "))"
        say = WorksheetFunction.CountIfs(ws.Range(Cells(2, "A"), Cells(lRow, "A")), ws.Range("A" & i), _
                ws.Range(Cells(2, "B"), Cells(lRow, "B")), ws.Range("B" & i))
        If say > 1 Then
            say2 = WorksheetFunction.CountIfs(ws.Range(Cells(i, "A"), Cells(lRow, "A")), ws.Range("A" & i), _
                ws.Range(Cells(i, "B"), Cells(lRow, "B")), ws.Range("B" & i))
            If say = say2 Then
                If ws.Range("D" & i) <> ws.Range("B" & i) Then ws.Range("D" & i) = ""
            Else
                ws.Range("D" & i) = ""
            End If
        Else
            If ws.Range("D" & i) <> ws.Range("B" & i) Then ws.Range("D" & i) = ""
        End If
    Next i

End Sub
 
Teşekkürler
 
Geri
Üst