PC-HELP.CZ

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

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

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

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.

PC-HELP.CZ

VBA rychlost - skryti prazdnych sloupcu

VBA rychlost - skryti prazdnych sloupcu

Re: VBA rychlost - skryti prazdnych sloupcu

Re: VBA rychlost - skryti prazdnych sloupcu

Re: VBA rychlost - skryti prazdnych sloupcu