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

• Mutt senior tag

  2024-11-07 15:53:38 #53484

  Új Válasz

  Ú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

  

  Mutt

  senior tag

  válasz Mutt üzenetére #53477

  Mivel kicsit zavart ezért itt a javítás.

  Sub FormatNumbers()
    Dim s As Range, sel 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 sel = Intersect(Selection, ActiveSheet.UsedRange)
    
    If Not sel Is Nothing Then
        
        'kijelölt adatokon végigmegyünk
        For Each s In sel
            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

  Akit érdekel a hibám a "For Each" sorban volt, ahol továbbra is a Selection (a felhasználó által kijelölt tartományt) használtam. Ha egy teljes oszlopot jelöl ki a felhasználó, akkor mind az 1 millió soron próbál végig menni a makró, ami lassú lesz. Ezért van a kódban előtte egy INTERSECT, amit elfelejtettem használni.

  üdv

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