Hirdetés

Keresés

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

  • Mutt

    senior tag

    válasz Mutt #53477 üzenetére

    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

  • Mutt

    senior tag

    válasz Mutt #53477 üzenetére

    Egy kis hibát látok a makróban. Egész oszlopon nem javasolt futtatni. Ha kell majd javítom.

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