DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Function ENÇOKOLAN(Alan As Range, Çokluk_Sırası As Long)
Dim Hücre As Range
Dim Dizi As Object
Dim WF As WorksheetFunction
Dim Say As Long
Dim X As Long
Dim Y As Long
Dim VeriA As Variant
Dim VeriB As Variant
Application.Volatile True
Set Dizi = CreateObject("Scripting.Dictionary")
Set WF = WorksheetFunction
ReDim Liste(1 To 2, 1 To 1)
For Each Hücre In Alan
If Hücre.Value <> "" Then
If Hücre.Height <> 0 Then
If Not Dizi.Exists(Hücre.Value) Then
Say = Say + 1
Dizi.Add Hücre.Value, 1
ReDim Preserve Liste(1 To 2, 1 To Say)
Liste(1, Say) = Hücre.Value
Liste(2, Say) = WF.CountIf(Alan, Hücre.Value)
End If
End If
End If
Next
For X = LBound(Liste, 2) To UBound(Liste, 2)
For Y = X + 1 To UBound(Liste, 2)
If Liste(2, X) < Liste(2, Y) Then
VeriA = Liste(1, Y)
VeriB = Liste(2, Y)
Liste(1, Y) = Liste(1, X)
Liste(2, Y) = Liste(2, X)
Liste(1, X) = VeriA
Liste(2, X) = VeriB
End If
Next
Next
ENÇOKOLAN = Liste(1, Çokluk_Sırası)
End Function
=İNDİS($A$1:$A$100;KAÇINCI(BÜYÜK(EĞER(EĞERSAY(DOLAYLI("A1:A"&SATIR($1:$100));$A$1:$A$100)+SATIR($1:$100)/1000=EĞERSAY($A$1:$A$100;$A$1:$A$100)+SATIR($1:$100)/1000;EĞERSAY($A$1:$A$100;$A$1:$A$100)+SATIR($1:$100)/1000);SATIR(A1));EĞER(EĞERSAY(DOLAYLI("A1:A"&SATIR($1:$100));$A$1:$A$100)+SATIR($1:$100)/1000=EĞERSAY($A$1:$A$100;$A$1:$A$100)+SATIR($1:$100)/1000;EĞERSAY($A$1:$A$100;$A$1:$A$100)+SATIR($1:$100)/1000);0))