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

• #52974 Fire/SOUL/CD félisten Fferi50 #52972

  Új Válasz 2024-07-20 02:06:31 #52974

  Ú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

  

  Fire/SOUL/CD

  félisten

  válasz Fferi50 #52972 üzenetére

  Úgyis régen makróztam, kedvem szottyant kicsit nosztalgiázni ezen a késői órán, szabályokat meg úgy értelmeztem, ahogy korábban.
  Ha másra nem is lesz jó, páran talán találnak benne hasznosítható dolgokat...

  

  Module1-be

  Option Explicit
'Fire/SOUL/CD - 2024
Public Function Fire_dm1970_FX(MyCell As Range) As String
    'elválasztó karakter (itt szóköz), ezzel vannak elválasztva a szavak a cellá(k)ban
    Const MYDELIMITER = " "
    
    'szöveg típusú dinamikus tömb
    Dim MyStringArray() As String
    
    'színek deklarálása tömbben (bármennyi lehet)
    Dim MyColors() As Variant
    MyColors() = Array("FEHÉR", "KÉK", "ZÖLD", "PIROS", "FEKETE", "HUPIKÉK")
    
    'ciklusszámláló
    Dim i As Long
    
    'az Ubound fx értékét ebben tároljuk
    Dim MyColorIndex As Long
    
    'SPLIT függvény segítségével, a MYDELIMITER paraméterrel tömböt hozunk létre
    MyStringArray = Split(MyCell.Value, MYDELIMITER)
    
    'végignézzük a tömb elemeit (szavakat a cellában, ami bármennyi lehet)
    For i = 0 To UBound(MyStringArray)
        
        'a tömb 0. eleme (első szó a cellában) egy deklarált szín?
        'ha igen, akkor a színt adjuk vissza és kilépünk a függvényből
        MyColorIndex = UBound(Filter(MyColors, MyStringArray(0), , vbTextCompare))
        If MyColorIndex > -1 Then
            Fire_dm1970_FX = UCase(MyStringArray(0))
            Exit Function
        End If
        
        'a tömb utolsó eleme (utolsó szó a cellában) egy deklarált szín?
        'ha igen, akkor a színt adjuk vissza és kilépünk a függvényből
        MyColorIndex = UBound(Filter(MyColors, MyStringArray(UBound(MyStringArray)), , vbTextCompare))
        If MyColorIndex > -1 Then
            Fire_dm1970_FX = UCase(MyStringArray(UBound(MyStringArray)))
            Exit Function
        End If
        
        'a tömb i-edik eleme egy deklarált szín?
        'ha igen, akkor az i+1-dik elemet (cellában első megtalált deklarált színt követő szót) adjuk vissza és kilépünk a függvényből
        MyColorIndex = UBound(Filter(MyColors, MyStringArray(i), , vbTextCompare))
        If MyColorIndex > -1 Then
            Fire_dm1970_FX = UCase(MyStringArray(i + 1))
            Exit Function
        End If
        
        'ha nem találtunk a cellában deklarált színt, akkor töröljük a cella tartalmát
        Fire_dm1970_FX = ""
        
    Next i
End Function

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