Keresés

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

  • 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. :DDD
    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

  • Fire/SOUL/CD

    félisten

    válasz Fferi50 #52972 üzenetére

    Korábban írtam, hogy ebből a példából le lehet vonni szabályt és arra lehet makrót írni, ami egyszerű(bb), de ha -ahogy írod is- figyelembe vesszük ezt is:
    "Az indító kérdésben még alma, körte, ivólé.... valamint kg és doboz szerepelt..."
    na akkor borul minden... :DDD

    Én is inkább megvárom, míg nem látom a konkrét táblát, mert addig gyárthatunk akármilyen megoldást, aztán a konkrét táblában meg semmire nem lesz jó... :DDD

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

Hirdetés