Új hozzászólás Aktív témák

• #19478 Mutt senior tag Nyomdász #19454

  Új Válasz 2013-11-07 22:49:34 #19478

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz Nyomdász #19454 üzenetére

  Hello,

  Tömbfüggvénnyel esetleg megoldható, illetve az újabb változatokban van GYAKORISÁG függvény, de ez sem segít sokat.

  A javaslatom egy saját függvény használata. Feltöltöttem ide egy mintával:
  https://www.sugarsync.com/pf/D0303523_164_627981888

  

  A függvénnyel mind a legtöbbször, mind a legkevesebbszer használt számokat meg lehet kapni.

  A kód a pedig:
  Function GYAKORI(Tartomany As Range, Elem As Long, Optional Kicsi As Boolean = False, Optional Rendezetlen As Boolean = False)
  Dim Adatok As New Collection 'egyedi számok tömbje
  Dim arryAdatok() 'végső tömb
  Dim rngAdatsor As Range 'adatokat tartalmazó terület
  Dim cell As Range
  Dim i As Long
  
  'csak a kijelölt és számokat tartalmazó terület metszetét vizsgáljuk
  Set rngAdatsor = Intersect(Tartomany, ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers))
  
  'a collection-be felvesszük a számokat, mivel csak egyedi értékeket
  'tud fogadni, ezért ki kell kapcsolni a hibakezelést
  On Error Resume Next
  'végigmegyünk az adatterületen és felvesszük a collection-be
  For Each cell In rngAdatsor
  Adatok.Add cell.Value, CStr(cell.Value)
  Next cell
  'hibakezelés visszakapcsolása
  On Error GoTo 0
  
  'létrehozunk egy két dimenziós tömböt: számokat és gyakoriságukat fogjuk tárolni
  ReDim arryAdatok(1 To Adatok.Count, 1 To 2)
  
  'feltöltjük a tömböt
  For i = 1 To UBound(arryAdatok, 1)
  'számérték
  arryAdatok(i, 2) = Adatok.Item(i)
  'számérték gyakorisága - DARABTELI-vel határozzuk meg
  arryAdatok(i, 1) = WorksheetFunction.CountIf(rngAdatsor, Adatok.Item(i))
  Next i
  
  'sorbarendezzük a számokat alapból (ha a rendezetlen IGAZ-ra van állítva akkor nem fut le)
  If Not Rendezetlen Then
  BubbleSort arryAdatok, 2
  End If
  
  'a gyakoriság (első dimenzió) szerint növekvő sorrendbe tesszük a tömböt
  'buborék rendezés kódja innen származik
  'http://social.msdn.microsoft.com/Forums/en-US/320f3328-cb4f-43ce-aedf-c0f00f253b64/sorting-a-2-dimension-array-in-excel-vba?forum=isvvba
  BubbleSort arryAdatok, 1
  
  'ha KICSI-ként használjuk a függvényt, akkor a tömb első elemei kellenek
  'ha NAGY-ként akkor viszont az utolsók
  If Not Kicsi Then
  Elem = UBound(arryAdatok, 1) - Elem + 1
  End If
  
  'eredmény
  GYAKORI = arryAdatok(Elem, 2)
  
  End Function

  üdv.

Új hozzászólás Aktív témák