VBA rychlost - skryti prazdnych sloupcu

[b965029@klzlk.com]

Ahoj Vsichni,

mohl bych poprosit o radu?
Napsal jsem si jednoduche makro, ve kterem prochazim vsechny bunky A:J, (ve kterych je znazornena stromova struktura) viz. prilozeny soubor a sloupecky ve kterych neni zadny zaznam makro skryje. Bohuzel dopredu nevim kolik bude strom obsahvat radek, proto jsem zvolil hodnotu 65000. Vyreseni ale tolika radek zabere az nekolik vterin Nevite jak tohle vyresit rychleji?

Dekuji

--- Doplnění předchozího příspěvku (26 Kvě 2011 10:12) ---

Rano moudrejsi vecera.
Pokud by nekdo potreboval tak uchazejici reseni by mohlo vypadat snad takhle.

Kód: Vybrat vše

Private Const MAX_RADEK = 65000
Private Const INDEX_J_SLOUPCE = 10

Private Sub Workbook_Open()

    Dim max_index As Integer
   
    ' Projdeme vsechny listy
    For Each sht In Sheets
        max_index = 0
        ' Na kazdem listu jeho sloupce A:J
        For radek = 2 To MAX_RADEK
            ' Vsechny radky, ktere maji v oblasti A:J nejakou zkratku
            For sloupec = 1 To INDEX_J_SLOUPCE
                If sht.Cells(radek, sloupec).Value <> 0 Then ' Pokud takovou zkratku najdeme tak si uchovame index daneho sloupce
                    If sloupec > max_index Then ' Chceme vzdy ten nejvetsi index
                        max_index = sloupec
                    End If
                    Exit For
                End If
            Next sloupec
            If sloupec > INDEX_J_SLOUPCE Then ' Od ziskaneho indexu do sloupce J spracujeme vsechny sloupce
           
                sht.Cells(1, max_index).EntireColumn.AutoFit ' Na sloupci ziskaneho indexu nastavime zoztazeni bunky (podle obsahu)
                For skryty = (max_index + 1) To INDEX_J_SLOUPCE
                    sht.Cells(1, skryty).EntireColumn.Hidden = True ' Sloupec schovame
                Next skryty
                Exit For
               
            End If
        Next radek
    Next sht

End Sub


[Reklama]

[Poki]

Pokud by nekdo potreboval najit poslendi radek z oblasti, ktera je na listu vyuzita, tak tohle je velice snadne:

Kód: Vybrat vše

List1.UsedRange.SpecialCells(xlCellTypeLastCell).Row

[b965029@klzlk.com]

Moc sikovna funkce. Dik!
Bozuzel jeji volani na uzamcenem listu vyhazuje run-time error 1004

[kuchyn]

Zdravím,
asi bych použil něco podobného s využitím UsedRange:

Sub HideColumns()
Dim Oblast As Range
Dim i As Integer

Set Oblast = ActiveSheet.UsedRange
For i = 1 To Oblast.Columns.Count
If Application.WorksheetFunction.CountA(Oblast.Columns(i)) = 0 Then
Oblast.Columns(i).EntireColumn.Hidden = True
Else
Oblast.Columns(i).EntireColumn.Hidden = False
End If
Next i
End Sub

Oblast by měla jít přizpůsobit podle potřeb.