Jdi na obsah Jdi na menu
Reklama
Založte webové stránky zdarma - eStránky.cz
 


Řádky a sloupce

25. 1. 2008

Průměrný sešit MS Excel obsahuje 1 102 řádku a 18,2 sloupců. Jak jsou na tom Vaše sešity? Touto informaci se dále zabýval Dick Kusleika a na stránce Daily Dose popsal průzkum na svých sešitech. Zároveň zde přiložil kód, pomocí něhož si můžete udělat analýzu svých sešitů sami.

Pro spuštění následujícího kódu, musíte přidat referenci Microsoft Scripting Runtime. Kód jsem mírně upravil, podle Johna Walkenbacha, který popsal v komentářích problém s rozlišením Microsft Excel dokumentů, pro verzi 2007. Na mém PC se stávalo, že kód neprošel všechny adresáře a ukončil se. Přišel jsem na to, že nesmím absolutně nic dělat s PC a jen odklikávat hlášky, které budou během zpracování vyskakovat (já si třeba perfektně uklidil stůl). Pravděpodobně budete i Vy muset odkliknout několik dialogů a otázek a počítejte s tím, že zpracování zabere několik minut. Zřejmě se Vám taky stane, že budete mít spousty listů které budou prázdné (poslední buňka bude A1), většinou to znamená, že daný sešit obsahuje pouze kód VBA, anebo jste nesmazali listy, které byly automaticky přidány při vytváření sešitu a následně jste je nepoužili ( taky je tam můžete mít schválně jako já, ale do průměru je nezapočitejte). Taky se Vám asi stane, že budete mít poslední buňku jako IV65536, to je neduh příkazu SpecialCells(xlCellTypeLastCell, proto zkontrolujte, jestli opravdu daný sešit má tolik řádku.
Kód můžete vyzkoušet a výsledky můžete napsat třeba do komentářů.

Dim iNumberFiles As Integer, lNumberSheets As Long
Sub LastCells()

 Dim sro As Scripting.FileSystemObject
 Dim srFolder As Scripting.Folder

 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False

 Set sro = New Scripting.FileSystemObject

 Set srFolder = sro.GetFolder("C:\")

 GetLastCells srFolder

 Application.Calculation = xlCalculationAutomatic

 Application.EnableEvents = True

 MsgBox "Pocet sešitu:" & iNumberFiles & vbCrLf & _
        "Počet listů: " & lNumberSheets

End Sub
Sub GetLastCells(srFolder As Scripting.Folder)

 Dim srFile As Scripting.File
 Dim srSubFolder As Scripting.Folder
 Dim wb As Workbook, sh As Worksheet, rLast As Range

 For Each srFile In srFolder.Files
  If UCase(ThisWorkbook.FullName) <> UCase(srFile) Then
   If Left(srFile.Type, 22) = "Microsoft Office Excel" Then
    iNumberFiles = iNumberFiles + 1
    On Error Resume Next
    Set wb = Workbooks.Open(srFile.Path, False, True)
    If Err.Number = 0 Then
     On Error GoTo 0
     For Each sh In wb.Worksheets
      If Not sh.ProtectContents Then
       lNumberSheets = lNumberSheets + 1
       Set rLast = sh.Cells.SpecialCells(xlCellTypeLastCell)
       With ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)
        .Offset(1, 0).Value = wb.FullName
        .Offset(1, 1).Value = rLast.Address
        .Offset(1, 2).Value = rLast.Row
        .Offset(1, 3).Value = rLast.Column
       End With
      End If
     Next sh

     If UCase(wb.FullName) <> UCase(ThisWorkbook.FullName) Then
       wb.Close False
     End If

    Else
     Err.Clear
     On Error GoTo 0
    End If
   End If
  End If
 Next srFile

  For Each srSubFolder In srFolder.SubFolders
    GetLastCells srSubFolder
  Next srSubFolder

End Sub


Všimněte si, že počet řádku je nastaven natvrdo na 65536, nesnáším tento typ zápisu, ale při změně na mé oblíbené
Cells(Rows.Count,1).End(xlUp)
docházelo k chybám za běhu a vzhledem k tomu, že mám pouze 1 sešit, který tento počet řádku přesahuje (cca 80 tisíc řádku), ponechal jsem tento příkaz tak jak je. Ovšem to neznamená, že je to dobře, silně nedoporučuji psát natvrdo počet řádku a raději vždy využijte příkaz, který jsem napsal výše.

Tady jsou mé výsledky:

Výpočet    Řádků    Sloupců
------------------------------------------
Průměr      1 050      17,9
Medián      40           9,0
Mode        29           4,0
Max          87 661     255

 

Komentáře

Přidat komentář

Přehled komentářů

Zatím nebyl vložen žádný komentář