Мартен задается вопросом, есть ли способ узнать размер каждого рабочего листа в книге. У него есть книга с почти 100 листами, и он хочет уменьшить размер файла книги. Однако он не знает, какие рабочие листы самые большие по размеру.

Определение «размера» отдельных листов в значительной степени зависит от того, что подразумевается под «размером». Означает ли это количество использованных ячеек? Используемые столбцы и строки? Сколько текста хранится на листе? Список показателей можно продолжать и продолжать.

Проблема в том, что такие вопросы не попадают в цель; на листе может храниться много-много элементов. Например, он может содержать комментарии, формулы, текст, диаграммы, звуковые файлы и любое количество других элементов. Одна диаграмма может быть больше другой с точки зрения количества ячеек, но другая может быть больше с точки зрения объектов (таких как диаграммы или сводные таблицы).

Единственный реальный способ сравнить относительные размеры рабочих листов — сохранить каждый рабочий лист в отдельной книге, а затем изучить размер каждой полученной книги. Очевидно, это не дает точного ответа на вопрос, насколько велик каждый отдельный рабочий лист, потому что процесс сохранения книги вносит дополнительные накладные расходы в сохраненный файл. Однако, если каждый рабочий лист сохраняется таким же образом, каждый из них будет иметь сопоставимые накладные расходы, и поэтому их можно будет сравнивать друг с другом, чтобы увидеть, какой из них больше.

Следующий макрос добавляет рабочий лист в текущую книгу, чтобы записать размеры каждой созданной книги. Затем он проходит через каждый рабочий лист и сохраняет его в отдельной книге. Затем определяется, записывается размер книги и удаляется новая книга.

Sub WorksheetSizes()

Dim wks As Worksheet     Dim c As Range     Dim sFullFile As String     Dim sReport As String     Dim sWBName As String

sReport = "Size Report"

sWBName = "Erase Me.xls"

sFullFile = ThisWorkbook.Path & _       Application.PathSeparator & sWBName

' Add new worksheet to record sizes     On Error Resume Next     Set wks = Worksheets(sReport)

If wks Is Nothing Then         With ThisWorkbook.Worksheets.Add(Before:=Worksheets(1))

.Name = sReport             .Range("A1").Value = "Worksheet Name"

.Range("B1").Value = "Approximate Size"

End With     End If     On Error GoTo 0     With ThisWorkbook.Worksheets(sReport)

.Select         .Range("A1").CurrentRegion.Offset(1, 0).ClearContents         Set c = .Range("A2")

End With

Application.ScreenUpdating = False     ' Loop through worksheets     For Each wks In ActiveWorkbook.Worksheets         If wks.Name <> sReport Then             wks.Copy             Application.DisplayAlerts = False             ActiveWorkbook.SaveAs sFullFile             ActiveWorkbook.Close SaveChanges:=False             Application.DisplayAlerts = True             c.Offset(0, 0).Value = wks.Name             c.Offset(0, 1).Value = FileLen(sFullFile)

Set c = c.Offset(1, 0)

Kill sFullFile         End If     Next wks     Application.ScreenUpdating = True End Sub

_Примечание: _

Если вы хотите узнать, как использовать макросы, описанные на этой странице (или на любой другой странице на сайтах ExcelTips), я подготовил специальную страницу, содержащую полезную информацию.

link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера].

ExcelTips — ваш источник экономичного обучения Microsoft Excel.

Этот совет (11113) применим к Microsoft Excel 2007 и 2010. Вы можете найти версию этого совета для старого интерфейса меню Excel здесь:

link: / excel-Finding_the_Size_of_Individual_Worksheets [Определение размера отдельных рабочих листов].