Namig: drugi jeziki so prevedeni v Google. Lahko obiščete English različico te povezave.
Vpiši se
x
or
x
x
Registracija
x

or

Kako preveriti velikost vsakega delovnega lista delovnega zvezka?

Če imate velik delovni zvezek, ki vsebuje več delovnih listov, zdaj pa želite ugotoviti, kakšna je velikost vsakega delovnega lista, da ugotovite, kateri list je treba zmanjšati. Ali obstajajo hitri načini za reševanje te naloge?

Preverite velikost vsakega delovnega lista s kodo VBA

Preverite velikost vsakega delovnega lista s programsko opremo Kutools for Excel


puščica modra desno mehurček Preverite velikost vsakega delovnega lista s kodo VBA


Z naslednjo kodo VBA lahko hitro pridobite velikost vsakega delovnega lista v vaši delovni zvezki. Prosimo, naredite tako:

1. Drži dol ALT + F11 tipke in odpre Okno Microsoft Visual Basic za aplikacije.

2. Kliknite Vstavi > Moduli, in prilepite naslednjo kodo v Okno modula.

VBA koda: preverite velikost vsakega delovnega lista v delovnem zvezku </ p>

Sub WorksheetSizes()
'Update 20140526
Dim xWs As Worksheet
Dim Rng As Range
Dim xOutWs As Worksheet
Dim xOutFile As String
Dim xOutName As String
xOutName = "KutoolsforExcel"
xOutFile = ThisWorkbook.Path & "\TempWb.xls"
On Error Resume Next
Application.DisplayAlerts = False
Err = 0
Set xOutWs = Application.Worksheets(xOutName)
If Err = 0 Then
    xOutWs.Delete
    Err = 0
End If
With Application.ActiveWorkbook.Worksheets.Add(Before:=Application.Worksheets(1))
    .Name = xOutName
    .Range("A1").Resize(1, 2).Value = Array("Worksheet Name", "Size")
End With
Set xOutWs = Application.Worksheets(xOutName)
Application.ScreenUpdating = False
xIndex = 1
For Each xWs In Application.ActiveWorkbook.Worksheets
    If xWs.Name <> xOutName Then
        xWs.Copy
        Application.ActiveWorkbook.SaveAs xOutFile
        Application.ActiveWorkbook.Close SaveChanges:=False
        Set Rng = xOutWs.Range("A1").Offset(xIndex, 0)
        Rng.Resize(1, 2).Value = Array(xWs.Name, VBA.FileLen(xOutFile))
        Kill xOutFile
        xIndex = xIndex + 1
    End If
Next
Application.ScreenUpdating = True
Application.Application.DisplayAlerts = True
End Sub

3. Nato pritisnite F5 ključ za izvedbo te kode in novega delovnega lista z imenom KutoolsforExcel bo vstavljen v trenutno delovno knjižico, ki vsebuje vsako ime delovnega lista in velikost datoteke, enota pa je Bit. Prikaz slike:

doc-preverjanje stanja velikosti1


puščica modra desno mehurček Preverite velikost vsakega delovnega lista s programsko opremo Kutools for Excel

Če imate Kutools za Excel, Z njegovim Delovni zvezek Split uporabnost, lahko celotno delovno knjižico razdelite v ločene datoteke in nato v določeno mapo preverite velikost posamezne datoteke.

Kutools za Excel vključuje več kot 300 priročno orodje Excel. Prosti brez omejitev v 30 dneh. Get it now.

Ko namestite Kutools za Excel, storite naslednje:

1. Odprite delovni zvezek, s katerim želite preveriti velikost vsakega delovnega lista, in kliknite Podjetje > Delovna knjiga > Delovni zvezek Split, si oglejte sliko zaslona:

doc-preverjanje stanja velikosti1

2. v Delovni zvezek Split dialog, preverite vse delovne liste in kliknite Split gumb, nato pa določite mapo za postavitev novih datotek delovne knjige. Oglejte si posnetke zaslona:

doc-preverjanje stanja velikosti3
-1
doc-preverjanje stanja velikosti4

3. In potem bo vsak delovni list vaše trenutne delovne knjige shranjen kot ločena datoteka Excel, lahko pa odprete svojo posebno mapo, da preverite velikost vsake delovne knjige.

doc-preverjanje stanja velikosti1

Če želite izvedeti več o tej funkciji delovnega zvezka.


Sorodni članki:

Kako razdeliti delovni zvezek za ločevanje datotek Excel v Excelu?

Kako izvoziti in shranjevati liste in delovne liste kot nov delovni zvezek v Excelu?


Priporočena orodja za produktivnost za Excel

zavihek kte 201905

Kutools za Excel vam pomaga, da vedno končate delo pred časom in izstopite iz množice

  • Več kot zmogljive napredne funkcije 300, zasnovane za 1500 delovne scenarije, ki povečujejo produktivnost z 70%, vam dajejo več časa za skrb za družino in uživanje v življenju.
  • Ne potrebujete več pomnilniških formul in VBA kod, od zdaj naprej pa dajate svojim možganom počitek.
  • Postanite strokovnjak za Excel v minutah 3, zapletene in ponavljajoče se operacije lahko opravite v nekaj sekundah,
  • Vsak dan zmanjšajte število operacij tipkovnice in miške, zdaj se poslovite od poklicnih bolezni.
  • 110,000 visoko učinkovite ljudi in 300 + svetovno priznanih podjetij izbiro.
  • Brezplačna preizkusna različica 60 dneva. 60-dnevno jamstvo vračila denarja. 2 let brezplačne nadgradnje in podpore.

Prinaša kartično brskanje in urejanje za Microsoft Office, veliko močnejši od zavihkov brskalnika

  • Office Tab je namenjen za Word, Excel, PowerPoint in druge Office aplikacije: Založnik, Dostop, Visio in Projekt.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Z 50% poveča vašo produktivnost in vsak dan zmanjša na stotine klikov z miško!
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Juliana · 1 months ago
    Very VeryVeryVeryVery helpful.
    Thank you!!
  • To post as a guest, your comment is unpublished.
    Ben S. · 2 years ago
    ' Part 3 of 3
    '--- paste break ---

    ' Format the output sheet
    Application.Sheets(xOutName).Activate
    Columns("B:B").Select
    Selection.NumberFormat = "#,##0_);(#,##0)"
    Columns("A:B").Select
    Columns("A:B").EntireColumn.AutoFit
    Range("A1").Select
    ' Even better, format it as a table.
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:B" & xIndex), , xlYes).Name = "WorksheetSizes"

    Application.ScreenUpdating = True
    Application.Application.DisplayAlerts = True
    Application.StatusBar = ""
    Application.Cursor = xlDefault

    Exit Sub

    ErrorHandler:

    MsgBox "Error #" & Err.Number & " - " & Err.Description & vbCrLf & "in procedure WorksheetSizes"

    End Sub
  • To post as a guest, your comment is unpublished.
    Ben S. · 2 years ago
    ' Part 2 of 3

    '--- paste break ---

    xWs.Visible = xlSheetVisible
    ' xOutFile = ThisWorkbook.Path & "\" & xWs.Name & ".xls"
    xWs.CopyQ
    Application.ActiveWorkbook.SaveAs xOutFile
    Application.ActiveWorkbook.Close SaveChanges:=False
    Set rng = xOutWs.Range("A1").Offset(xIndex, 0)
    rng.Resize(1, 2).Value = Array(xWs.Name, VBA.FileLen(xOutFile))
    Kill xOutFile

    xIndex = xIndex + 1
    End If
    Next

    ' Repeat the above for chart sheets.
    For Each xWs In Application.ActiveWorkbook.Charts
    If xWs.Name xOutName Then
    Application.StatusBar = "Calculating Worksheet Sizes, Sheet " & xIndex & " of " & ActiveWorkbook.Worksheets.count - 1 & " - " & xWs.Name
    Debug.Print "Calculating Worksheet Sizes, Sheet " & xIndex & " of " & ActiveWorkbook.Worksheets.count - 1 & " - " & xWs.Name
    DoEvents ' include this so CTRL+Break can be detected.

    xWs.Visible = xlSheetVisible

    xOutFile = ThisWorkbook.Path & "\" & xWs.Name & ".xls"

    xWs.Copy
    Application.ActiveWorkbook.SaveAs xOutFile
    Application.ActiveWorkbook.Close SaveChanges:=False
    Set rng = xOutWs.Range("A1").Offset(xIndex, 0)
    rng.Resize(1, 2).Value = Array(xWs.Name, VBA.FileLen(xOutFile))
    'Kill xOutFile

    xIndex = xIndex + 1
    End If
    Next

    '--- paste break ---
  • To post as a guest, your comment is unpublished.
    Ben S. · 2 years ago
    Here is a copy of the routine with a few enhancements I added. I had to break it into multiple posts due to the site limits.

    Public Sub WorksheetSizes()
    'Update 20140526
    ' https://www.extendoffice.com/documents/excel/1682-excel-check-size-of-each-sheet.html
    '
    ' BS 4/4/2016: Modified to have a status bar and format the output.
    ' Fixed for hidden sheets that caused it to crash.
    ' Added support for Chart sheets

    Dim xWs As Object ' Worksheet or Chart
    Dim rng As Range
    Dim xOutWs As Worksheet
    Dim xOutFile As String
    Dim xOutName As String
    Dim xIndex As Long
    On Error GoTo ErrorHandler

    Application.Cursor = xlWait

    xOutName = "KutoolsforExcel"
    xOutFile = ThisWorkbook.Path & "\TempWb.xls"
    On Error Resume Next
    Application.DisplayAlerts = False
    Err = 0
    Set xOutWs = Application.Worksheets(xOutName)
    If Err = 0 Then
    xOutWs.Delete
    Err = 0
    End If
    With Application.ActiveWorkbook.Worksheets.Add(Before:=Application.Worksheets(1))
    .Name = xOutName
    .Range("A1").Resize(1, 2).Value = Array("Worksheet Name", "Size")
    End With
    Set xOutWs = Application.Worksheets(xOutName)
    Application.ScreenUpdating = False
    xIndex = 1

    Debug.Print ThisWorkbook.Path

    For Each xWs In Application.ActiveWorkbook.Worksheets
    If xWs.Name xOutName Then
    Application.StatusBar = "Calculating Worksheet Sizes, Sheet " & xIndex & " of " & ActiveWorkbook.Worksheets.count - 1 & " - " & xWs.Name
    Debug.Print "Calculating Worksheet Sizes, Sheet " & xIndex & " of " & ActiveWorkbook.Worksheets.count - 1 & " - " & xWs.Name
    DoEvents ' include this so CTRL+Break can be detected.
    '--- paste break ---
  • To post as a guest, your comment is unpublished.
    Bob M · 3 years ago
    Hey Ben,
    Could you repaste the whole string of text with items #2 and #4 from your email added in? MY VBA knowledge is pretty limited and I'm not sure exactly where to add them into the For loop. My workbook has a number of hidden sheets and keeps crashing during the macro execution.

    Thanks,
    Bob