Řádky a sloupce
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