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

• #53477 Mutt senior tag KaliJoe #53475

  Új Válasz 2024-11-07 00:09:05 #53477

  Ú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 KaliJoe #53475 üzenetére

  Szia,

  Az én megoldásom azon alapszik, hogy van egy táblázat amely tartalmaz pár adatot ami alapján meg lehet találni, hogy melyik formátumot kell használni.
  Mutatom.
  
  Jobb oldalt van a táblázat, amiben a telefonszám első pár karaktere van megadva (lehet dzsóker karaktert - kérdőjel most csak - is használni). Aztán van hossz is, hogy az altípusokat meg lehessen különböztetni (biztosra mentem és tartományt lehet megadni).
  Majd jön a kívánt számformátum, itt követni kell az Excel speciális számformátum szabályait. Meg lehet adni, hogy milyen háttérszíne legyen a cellának (három szám 0-255 között, vesszővel felsorolva a vörös-zöld-kék alapszínekhez). A komment pedig segít eligazodni a káoszban.

  A táblázatban fontos a sorrend. Ha több lehetőség is van akkor is az első találatot fogja használni a makró.

  Ezek után a makró:

  Option Explicit
Dim arrFormats

  Sub FormatNumbers()
    Dim s As Range
    Dim r As Variant
    Dim szinek As Variant
    
    'megadott formátumokat memóriába töltjük
    'ha más a tábla neve akkor a tFormats helyére a helyes kerüljön
    arrFormats = ActiveSheet.ListObjects("tFormats").DataBodyRange.Value
        
    Set s = Intersect(Selection, ActiveSheet.UsedRange)
    
    If Not s Is Nothing Then
        
        'kijelölt adatokon végigmegyünk
        For Each s In Selection
            r = FindFormat(s.Value)
        
            If IsArray(r) Then
                'a cél cella formázását levesszük
              s.ClearFormats
                
                'beállítjuk a formátumot
              s.NumberFormat = r(1)
                
                'ha van színezünk
                If r(2) <> "" Then
                    szinek = Split(r(2), ",")
                  If UBound(szinek) = 2 Then s.Interior.Color = RGB(szinek(0), szinek(1), szinek(2))
                End If
                
            End If
        Next s
        
    End If
End Sub
Function FindFormat(p As String) As Variant
    Dim i As Long
    Dim pFormat(1 To 2)     'formátum és színkód
    Dim pKezdo As String
    Dim pHossz As Long
    
    pHossz = Len(p)
    FindFormat = ""
    
    If pHossz = 0 Then Exit Function
    
  'végigmegyünk a létező formátumokon
    For i = 1 To UBound(arrFormats)
        pKezdo = ""
        
        'hossz alapján keresünk egyezést
        If arrFormats(i, 2) >= pHossz And arrFormats(i, 3) <= pHossz Then
            
            pKezdo = arrFormats(i, 1)
            
            'kezdõ karakterek alapján keresünk egyezést
            If Left(p, Len(pKezdo)) Like pKezdo Then
                
                'ha van egyezés akkor elmentjük és kilépünk a ciklusból
                pFormat(1) = arrFormats(i, 4)
                pFormat(2) = arrFormats(i, 5)
                FindFormat = pFormat
                Exit For

              End If
            
        End If
    Next i
    
End Function

  Csak a kijelölt cellák formátumát változtatja meg! Vagyis előbb jelöljük ki a cellákat/oszlopokat és utána futassuk (Alt+F8-at nyomva vagy egy gombot kitéve).

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