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

• #53634 Mutt senior tag andreas49 #53631

  Új Válasz 2024-12-02 23:54:42 #53634

  Ú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 andreas49 #53631 üzenetére

  Szia,

  Az aktuális munkalapon próbálja meg átalakítani a dátumokat a kijelölt cellákban.

  Sub DatumAlakit()
    Dim adatok As Range, adat As Range
    Dim lapnev As String
    Dim honap As String, nap As String, eredmeny As String
    Dim magyarHonap, angolHonap
    Dim c As Long, karakter As String * 1
        
    angolHonap = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
    magyarHonap = Array("jan#", "feb#", "már#", "ápr#", "máj#", "jún#", "jûl#", "aug#", "szept#", "okt#", "nov#", "dec#")
    lapnev = Trim(ActiveSheet.Name)
    Set adatok = Intersect(ActiveSheet.UsedRange, Selection)
    
    For Each adat In adatok
        nap = ""
        honap = ""
        eredmeny = adat
        
        'csak akkor fusson le ha még nincs évszám
        If InStr(1, adat, lapnev) = 0 Then
            
            'karakternként végigmegyünk a cella tartalmán
            For c = 1 To Len(adat)
                'ha szám van akkor a nap tömbbe tesszük, ha betû a hónap tömbbe
                karakter = Mid(adat, c, 1)
                Select Case UCase(karakter)
                    Case "0" To "9", "-"
                        nap = nap & karakter
                    Case "A" To "Z"
                        honap = honap & karakter
                End Select
            Next c
            
        End If
        
        'angol hónap nevek magyarra cserélése
        For c = 0 To UBound(angolHonap)
            honap = Replace(honap, angolHonap(c), magyarHonap(c), Compare:=vbTextCompare)
        Next c
        
        'végeredmény összerakása
        Dim honapok, napok
        If Len(honap) > 0 And Len(nap) > 0 Then
        
            honapok = Split(Left(honap, Len(honap) - 1), "#")
            'ha van hónap akkor használjuk
            If IsArray(honapok) Then
            
                If UBound(honapok) > 0 Then
                    'ha több hónap van, akkor több nap is kell
                    napok = Split(nap, "-")
                
                    eredmeny = lapnev & ". " & Replace(honapok(0), "#", "") & ". " & napok(0) & " - " _
                                             & Replace(honapok(1), "#", "") & ". " & napok(1)
                
                Else
                    eredmeny = lapnev & ". " & Replace(honapok(0), "#", "") & ". " & nap
                End If
            
            End If
        End If
        
        'adat.Offset(, 1) = eredmeny        'teszteléshez ezt a sort aktiváld, a következõd kommenteld be
        adat = eredmeny
    Next adat
End Sub

  Nem tudom, hogy mennyire megy a te adatsorodon. Érdemes előbb egy teszt fájlban kipróbálni.

  üdv

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