Изменение ширины столбца в excel макросом - Word и Excel

Изменение размера ячейки в VBA Excel. Высота строки, ширина столбца, автоподбор ширины ячейки. Свойства RowHeight и ColumnWidth объекта Range.

Размер ячейки

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

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

Высота строки и ширина столбца в Excel

Программно, без дополнительных макросов, можно изменять высоту строки только в пунктах, а ширину столбца только в символах.

На сайте поддержки офисных приложений Microsoft так написано об этих величинах:

высота строки может принимать значение от 0 до 409 пунктов, причем 1 пункт приблизительно равен 1/72 дюйма или 0,035 см;
ширина столбца может принимать значение от 0 до 255, причем это значение соответствует количеству символов, которые могут быть отображены в ячейке.

Смотрите, как сделать все ячейки рабочего листа квадратными.

Высота строки

Для изменения высоты строки используйте свойство RowHeight объекта Range. И не важно, будет объект Range представлять из себя выделенный произвольный диапазон, отдельную ячейку, целую строку или целый столбец — высота всех строк, пересекающихся с объектом Range будет изменена после присвоения свойству RowHeight этого объекта нового значения.

Примеры изменения высоты строк:

Пример 1
Изменение высоты отдельной ячейки:

ActiveCell.RowHeight = 10

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

Пример 2
Изменение высоты строки:

в результате, третья строка рабочего листа приобретает высоту, равную 30 пунктам.

Пример 3
Изменение высоты ячеек заданного диапазона:

Range(«A1:D6»).RowHeight = 20

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

Пример 4
Изменение высоты ячеек целого столбца:

Columns(5).RowHeight = 15

в результате, всем строкам рабочего листа будет назначена высота, равная 15 пунктам.

Ширина столбца

Для изменения ширины столбца используйте свойство ColumnWidth объекта Range. Как и в случае с высотой строки, не важно, будет объект Range представлять из себя выделенный произвольный диапазон, отдельную ячейку, целую строку или целый столбец — ширина всех столбцов, пересекающихся с объектом Range будет изменена после присвоения свойству ColumnWidth этого объекта нового значения.

Примеры изменения ширины столбцов:

Пример 1
Изменение ширины отдельной ячейки:

ActiveCell.ColumnWidth = 15

в результате, столбец, в котором находится активная ячейка, приобретает ширину, равную 15 символам.

Пример 2
Изменение ширины столбца:

Columns(3).ColumnWidth = 50

в результате, третий столбец рабочего листа (столбец «C») приобретает ширину, равную 50 символам.

Пример 3
Изменение ширины ячеек заданного диапазона:

Range(«A1:D6»).ColumnWidth = 25

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

Пример 4
Изменение ширины ячеек целой строки:

в результате, всем столбцам рабочего листа будет назначена ширина, равная 35 символам.

Автоподбор ширины

Для автоподбора ширины ячейки в соответствие с размером ее содержимого используйте следующий код:

‘запишем для примера в любую ячейку рабочего

‘листа какой-нибудь текст, например, такой:

Cells(5, 5) = «Автоподбор ширины ячейки»

‘теперь подгоним ширину ячейки, а точнее

‘столбца, в котором эта ячейка находится:

Cells(5, 5).EntireColumn.AutoFit

Имейте в виду, что ширина столбца будет подогнана по расположенной в этом столбце ячейке с самым длинным содержимым. Например, если длина содержимого ячейки Cells(7, 5) будет превышать длину содержимого ячейки Cells(5, 5), то автоподбор ширины пятого столбца произойдет по содержимому ячейки Cells(7, 5), несмотря на то, что в строке кода указана другая ячейка.

Как осуществить автоподбор ширины объединенной ячейки, в которой метод AutoFit не работает, смотрите в следующей статье.

Источник

616 / 0 / 1

Регистрация: 24.07.2013

Сообщений: 93

Удаление столбцов и изменение их ширины

15.01.2014, 10:18. Показов 8655. Ответов 16

Здравствуйте, имеется таблица, помогите с написанием макроса по редактированию этой таблицы для Excel 2010.
Значит таблица выводится в excel с программы. Я в ручную ее буду сохранять на ПК и запускать заново. Далее необходимом написать макрос и добавить в личную книгу макросов, чтоб он всегда был прописан в excel, и назначить ему комбинацию клавиш (к примеру ctrl + z).
Во вложении приведена сама таблица, и то что должно получиться после редактирования.
Длина таблицы не фиксированная, может меняться.

Макрос должен:

Удалить:
Столбец A,D,I,J
Строка 1

Изменить ширину столбцов:
A — 28 (201 пиксель)
B,C — 4,57 (37 пикселей)
D — без изменений
E,F — 18 (131 пиксель)

Удалить данные столбца D с ячейки D3 и до конца

Изменить в строке 1 высоту шрифта до 11 и выравнивание текста по середине
Изменить высоту строки 1 — 48 (64 пикселя)

Нарисовать все границы таблица с A до J со строки 1 и до конца данных

Вот такая вот задумка, но что то у меня ничего не выходит, может кто поможет, заранее спасибо!

образец до.xlsx образец после.xlsx

RAVproFFI

33 / 33 / 1

Регистрация: 15.10.2013

Сообщений: 130

15.01.2014, 10:48

запусти запись макроса. Больше половины из того что тебе надо запишется. Единственное нужно будет поправить «с ячейки D3 и до конца»

Visual Basic

1 2	R=ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 range(cells(3,4),cells(R,4))

и «со строки 1 и до конца»

Visual Basic

1	range(cells(1,1),cells(R,10))

strike383

616 / 0 / 1

Регистрация: 24.07.2013

Сообщений: 93

15.01.2014, 11:06

[ТС]

Visual Basic

Sub Макрос1()
'
' Макрос1 Макрос
'
' Сочетание клавиш: Ctrl+z
'
    Range("A:A,D:D,I:I,J:J").Select
    Range("J1").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 28
    Columns("B:B").Select
    Range("B2").Activate
    Selection.ColumnWidth = 4.57
    Columns("C:C").Select
    Range("C2").Activate
    Selection.ColumnWidth = 4.57
    Columns("E:E").Select
    Range("E2").Activate
    Selection.ColumnWidth = 18
    Columns("F:F").Select
    Range("F2").Activate
    Selection.ColumnWidth = 18
    Range("D3:D344").Select
    Selection.ClearContents
    Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Rows("1:1").Select
    Selection.RowHeight = 48
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A1:F344").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1:F1").Select
End Sub

пишет ошибку тут Selection.Delete Shift:=xlToLeft

Ушел с CyberForum совсем!

873 / 182 / 25

Регистрация: 04.05.2011

Сообщений: 1,020

Записей в блоге: 110

15.01.2014, 11:17

строки сверху вниз удаляешь ? учти что после удаления строки 1, строка 4 станет строкой 3 и т.д…

RAVproFFI

33 / 33 / 1

Регистрация: 15.10.2013

Сообщений: 130

15.01.2014, 11:24

strike383, удали от .Select до ближайшего Selection
н-р: замени

PureBasic

1
2
3

Range("A:A,D:D,I:I,J:J").Select
    Range("J1").Activate
    Selection.Delete Shift:=xlToLeft

на

PureBasic

1	Range("A:A,D:D,I:I,J:J").Delete Shift:=xlToLeft

и т.д.
а также удали все ActiveWindow.ScrollColumn…. и ненужное форматирование текста и границ

Surrogate

Ушел с CyberForum совсем!

873 / 182 / 25

Регистрация: 04.05.2011

Сообщений: 1,020

Записей в блоге: 110

15.01.2014, 11:28

Сообщение от strike383

Range(«A:A,D,I:I,J:J»).Select
* * Range(«J1»).Activate
* * Selection.Delete Shift:=xlToLeft

зачем здесь Range(«J1»).Activate ?
у меня работает и так

Visual Basic

1 2	Range("A:A,D:D,I:I,J:J").Select Selection.Delete Shift:=xlToLeft

и так

Visual Basic

1	Range("A:A,D:D,I:I,J:J").Delete Shift:=xlToLeft

strike383

616 / 0 / 1

Регистрация: 24.07.2013

Сообщений: 93

15.01.2014, 12:06

[ТС]

исправил:

Visual Basic

Sub Макрос1()
'
' Макрос1 Макрос
'
' Сочетание клавиш: Ctrl+z
'
    Range("A:A,D:D,I:I,J:J").Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Rows("1:1").Delete Shift:=xlUp
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 28
    Columns("B:B").Select
    Range("B2").Activate
    Selection.ColumnWidth = 4.57
    Columns("C:C").Select
    Range("C2").Activate
    Selection.ColumnWidth = 4.57
    Columns("E:E").Select
    Range("E2").Activate
    Selection.ColumnWidth = 18
    Columns("F:F").Select
    Range("F2").Activate
    Selection.ColumnWidth = 18
    Range("D3:D344").Select
    Selection.ClearContents
    Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Rows("1:1").Select
    Selection.RowHeight = 48
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A1:F344").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1:F1").Select
End Sub

Работает, вот только ширина столбцов везде 18 почему то

Сообщение от RAVproFFI

Visual Basic

1 2	R=ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 range(cells(3,4),cells(R,4))

и «со строки 1 и до конца»

Visual Basic

1	range(cells(1,1),cells(R,10))

можно с примером в моем коде, где что изменить

Добавлено через 1 минуту
и что то мне подсказывает что в коде много лишнего, что убрать?

Surrogate

Ушел с CyberForum совсем!

873 / 182 / 25

Регистрация: 04.05.2011

Сообщений: 1,020

Записей в блоге: 110

15.01.2014, 12:33

Сообщение от RAVproFFI

а также удали все ActiveWindow.ScrollColumn….

2. все изменения ширины столбцов

Visual Basic

1
2
3

 Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 28

можно записать сокращенно

Visual Basic

1	Columns("A:A").ColumnWidth = 28

далее по аналогии

Добавлено через 5 минут
3.

Visual Basic

Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 22
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

можно ограничиться лишь изменением размера шрифта

Visual Basic

1 2	Range("A1:F1").Select Selection.Font.Size = 11

Добавлено через 8 минут

Сообщение от RAVproFFI

а также удали все ActiveWindow.ScrollColumn…. и ненужное форматирование текста и границ

если форматирование границ все же нужно, то для сокращения объема кода можно использовать фичу из этого поста

strike383

616 / 0 / 1

Регистрация: 24.07.2013

Сообщений: 93

15.01.2014, 14:24

[ТС]

Помогите отредактировать еще эту часть кода, нужно удалить данные со столбца D, начиная с ячейки D3 и до конца таблицы, длина таблицы может быть любой, но согласно этому коду данные будут удаляться до ячейки D344. Конечно можно написать чтоб данные удалялись, скажем до D10000, но это же не правильно, как прописать чтоб до конца таблицы удалялось?

Visual Basic

1 2	Range("D3:D344").Select Selection.ClearContents

Помогите еще с границами таблицы. Ее длина может меняться. А согласно коду ниже, ее границы прописаны конкретно от A1 до F344. Нужно чтоб границы были от A1 до F , но не 344, а до конца строк с данными

Visual Basic

Range("A1:F344").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

Добавлено через 1 минуту
Тоесть нужно чтоб прорисовались границы всей таблицы

RAVproFFI

33 / 33 / 1

Регистрация: 15.10.2013

Сообщений: 130

15.01.2014, 14:55

strike383, Range(«D3: D344») замени как я писал

PureBasic

1 2	R=ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 range(cells(3,4),cells(R,4)).ClearContents

cells(3,4) это D4, а cells(R,4) это D(последняя ячейка)
а кстати зачем .ClearContents? это удаляет все данные в ячейках. Сам смотри
а с границами также замени на

PureBasic

 with range(cells(1,1),cells(R,6))
  .Borders(xlDiagonalDown).LineStyle = xlNone
  .Borders(xlDiagonalUp).LineStyle = xlNone
  .Borders(xlEdgeLeft).LineStyle = xlContinuous
  .Borders(xlEdgeTop).LineStyle = xlContinuous
  .Borders(xlEdgeBottom).LineStyle = xlContinuous
  .Borders(xlEdgeRight).LineStyle = xlContinuous
  .Borders(xlInsideVertical).LineStyle = xlContinuous
  .Borders(xlInsideHorizontal).LineStyle = xlContinuous
end with

Добавлено через 15 минут
кстати все границы можно сделать одной строкой

PureBasic

1	range(cells(1,1),cells(R,6)).Borders.LineStyle = xlContinuous

чет сразу не подумал

616 / 0 / 1

Регистрация: 24.07.2013

Сообщений: 93

15.01.2014, 14:58

[ТС]

RAVproFFI, спасибо, попробую, но завтра, сегодня не получится, отпишусь о результатах

Еще такой вопрос, как в макросе прописать, чтоб то что получилось в конце, отправилось на печать, далее сама таблиса сохранилась, ну скажем на диске C:/Test, а место имени дата,месяц,год сохранения, и без макрос. После чего файл закрывается. Это вообще можно сделать?

33 / 33 / 1

Регистрация: 15.10.2013

Сообщений: 130

15.01.2014, 15:06

могу написать, но будет полезней если сам попробуешь>
запусти запись макроса, нажми печать, сохрани где нужно
затем в коде замени имя сохраняемой книги на Date & «.xlsx»
полученной код скопируй в конец предыдущего

616 / 0 / 1

Регистрация: 24.07.2013

Сообщений: 93

15.01.2014, 15:08

[ТС]

Ок, попробую, завтра отпишусь ))

33 / 33 / 1

Регистрация: 15.10.2013

Сообщений: 130

15.01.2014, 15:13

да и еще будет полезно: чтоб экран не моргал когда код делает свою работу — в самом начале кода вставь Application.ScreenUpdating = False, а в конце Application.ScreenUpdating = True
все будет быстрее и незаметно

strike383

616 / 0 / 1

Регистрация: 24.07.2013

Сообщений: 93

16.01.2014, 18:23

[ТС]

Ок, так и сделаю, спасибо

Добавлено через 11 часов 48 минут
По второму вопросу вот что получилось:

Visual Basic

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    ChDir "C:Temp"
    ActiveWorkbook.SaveAs Filename:="C:TempDate&.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False

Вообщем на печать без проблем отправляет, с сохранением небольшие загвоздки.
Во первых пишет место имени не дату сохранения, а Date& .
Во вторых каждый раз появляется сохранение что мол я хочу сохранить без поддержки макрос, нажимать приходится «да», хотелось бы что он сам сохранял без поддержки макрос.
Ну и в дополнении ко всем, можно ли еще изменить код, чтоб в конце висело окно с предложением сохранить в папку определенную и датой сохранения в имени без макрос, но без нажатия кнопки «Сохранить». Ну тоесть чтоб я мог в случае необходимости изменить имя, например дату вчерашнюю поставить, или вообще отказаться от сохранения, или просто нажать «сохранить».

Добавлено через 2 минуты
По первой части, все работет без проблем, вот что получилось:

Visual Basic

Sub Макрос1()
'
' Макрос1 Макрос
'
' Сочетание клавиш: Ctrl+z
'
   Application.ScreenUpdating = False
    Range("A:A,D:D,I:I,J:J").Delete Shift:=xlToLeft
    Rows("1:1").Delete Shift:=xlUp
    Columns("A:A").ColumnWidth = 28
    Columns("B:B").ColumnWidth = 4.57
    Columns("C:C").ColumnWidth = 4.57
    Columns("E:E").ColumnWidth = 18
    Columns("F:F").ColumnWidth = 18
    R = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    Range(Cells(3, 4), Cells(R, 4)).ClearContents
    Range("A1:F1").Select
    Selection.Font.Size = 11
    Rows("1:1").Select
    Selection.RowHeight = 48
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range(Cells(1, 1), Cells(R, 6)).Borders.LineStyle = xlContinuous
    Range("A1:F1").Select
   Application.ScreenUpdating = True
End Sub

Добавлено через 15 часов 12 минут

Сообщение от strike383

По второму вопросу вот что получилось:

Visual Basic

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    ChDir "C:Temp"
    ActiveWorkbook.SaveAs Filename:="C:TempDate&.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False

Может кто помочь с этим кодом?

strike383

616 / 0 / 1

Регистрация: 24.07.2013

Сообщений: 93

17.01.2014, 19:05

[ТС]

Все, сам сделал сохранение, кому интересно:

Visual Basic

1
2
3

strNewName = (Date & ".xlsx")
    If Not Application.Dialogs(xlDialogSaveAs).Show("C:Temp" & strNewName) Then _
        MsgBox "Книга не сохранена!", vbExclamation

RAVproFFI

33 / 33 / 1

Регистрация: 15.10.2013

Сообщений: 130

17.01.2014, 22:29

strike383, малорик
замени

Сообщение от strike383

Range(«A1:F1»).Select
Selection.Font.Size = 11
Rows(«1:1»).Select
Selection.RowHeight = 48
With Selection

на:

PureBasic

Range("A1:F1").Font.Size = 11
    Rows("1:1").RowHeight = 48
    With Rows("1:1")
       ...

и Range(«A1:F1»).Select в конце убери

Источник

Trambulanga

Пользователь

Сообщений: 21
Регистрация: 11.01.2023

18.02.2023 10:39:18

Доброго дня.
Есть ли в VBA метод, с помощью которого, можно задавать ширину определенным столбцам?
Например:
Мне необходимо, чтобы в таблице, столбцы 1,4,7… были шириной в 20 символов. Столбцы 2,5,8… шириной в 15 символом. и так далее.
Как задать параметры, не удлинняя код программы?
Автоподбор не нужен.
В данный момент все выглядит вот так:

Код

.Columns(1).ColumnWidth = 20
    .Columns(2).ColumnWidth = 13
    .Columns(3).ColumnWidth = 5
    .Columns(4).ColumnWidth = 20
    .Columns(5).ColumnWidth = 13
    .Columns(6).ColumnWidth = 5
    .Columns(7).ColumnWidth = 20
    .Columns(8).ColumnWidth = 13
    .Columns(9).ColumnWidth = 5
    .Columns(10).ColumnWidth = 20
    .Columns(11).ColumnWidth = 13
    .Columns(12).ColumnWidth = 5
    .Columns(13).ColumnWidth = 20
    .Columns(14).ColumnWidth = 13
    .Columns(15).ColumnWidth = 5
    .Columns(16).ColumnWidth = 20
    .Columns(17).ColumnWidth = 13
    .Columns(18).ColumnWidth = 5

Изменено: Trambulanga — 18.02.2023 11:19:04

Artem1977

Пользователь

Сообщений: 163
Регистрация: 28.02.2017

18.02.2023 12:07:18

Trambulanga, например для представленных строк так:

Код
Dim i As Integer For i = 1 To 16 Step 3 With Sheets(1) .Columns(i).ColumnWidth = 20 .Columns(i + 1).ColumnWidth = 13 .Columns(i + 2).ColumnWidth = 5 End With Next

Изменено: Artem1977 — 18.02.2023 12:17:33

Microsoft Office 2010 64-bit, Windows 10 Professional 64-bit

Настя_Nastya

Пользователь

Сообщений: 801
Регистрация: 14.07.2019

18.02.2023 12:12:10

или так

Код

Sub h()
C1 = 20
C2 = 13
C3 = 5
On Error Resume Next
For i = 1 To 18
    If i = 1 Then ActiveSheet.Columns(1).ColumnWidth = C1
    If ActiveSheet.Columns(i - 1).ColumnWidth = C1 Then ActiveSheet.Columns(i).ColumnWidth = C2
    If ActiveSheet.Columns(i - 1).ColumnWidth = C2 Then ActiveSheet.Columns(i).ColumnWidth = C3
    If ActiveSheet.Columns(i - 1).ColumnWidth = C3 Then ActiveSheet.Columns(i).ColumnWidth = C1
Next i
End Sub

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

18.02.2023 12:22:13

Код

Sub SetColumnWidth()
  Dim c, rg As Range, w
  Set rg = Columns(1):  w = Array(29, 13, 5)
  For c = 4 To 16 Step 3: Set rg = Union(rg, Columns(c)): Next
  For c = 0 To 2: rg.Offset(0, c).ColumnWidth = w(c): Next
End Sub

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

БМВ

Модератор

Сообщений: 21380
Регистрация: 28.12.2016

Excel 2013, 2016

18.02.2023 13:25:12

в коллекцию

Код

With ActiveSheet
    .Columns(1).ColumnWidth = 20
    .Columns(2).ColumnWidth = 13
    .Columns(3).ColumnWidth = 5
    .Columns(1).Resize(, 3).Copy
    .Columns(1).Resize(, 18).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End With

По вопросам из тем форума, личку не читаю.

	Всем большое спасибо за помощь! О таком количестве методов я и не подозревал)))

Msi2102

Пользователь

Сообщений: 3137
Регистрация: 31.03.2014

18.02.2023 18:47:49

Цитата
Trambulanga написал: О таком количестве методов я и не подозревал

Вот ещё парочка, мне кажется это можно продолжать бесконечно

Код

Sub Макрос1()
    Set col_1 = Union(Columns(1), Columns(4), Columns(7), Columns(10), Columns(13), Columns(16))
    Set col_2 = Union(Columns(2), Columns(5), Columns(8), Columns(11), Columns(14), Columns(17))
    Set col_3 = Union(Columns(3), Columns(6), Columns(9), Columns(12), Columns(15), Columns(18))
    col_1.ColumnWidth = 20
    col_2.ColumnWidth = 13
    col_3.ColumnWidth = 5
End Sub

Код

Sub Макрос1()
    Dim col_1 As Range, m As Byte, arr1 As Variant
    arr1 = Array(20, 13, 5)
    For m = 1 To 3
        For n = m To 15 + m Step 3
            If col_1 Is Nothing Then Set col_1 = Columns(n) Else Set col_1 = Union(col_1, Columns(n))
        Next
        col_1.ColumnWidth = arr1(m - 1):    Set col_1 = Nothing
    Next
End Sub

Изменено: Msi2102 — 18.02.2023 19:29:31

Апострофф

Пользователь

Сообщений: 720
Регистрация: 06.04.2015

18.02.2023 20:37:25

Код
For C = 1 To 18 Columns(C).ColumnWidth = Split("20 13 5")((C - 1) Mod 3) Next

nilske Пользователь Сообщений: 354 Регистрация: 30.11.2018	Апострофф, супер! Останется только привязать мод к количеству элементов в переменной Изменено: nilske — 18.02.2023 21:21:15

Апострофф Пользователь Сообщений: 720 Регистрация: 06.04.2015	nilske, если удосужитесь ручками набрать «20 13 5 10 15», угадайте, что будет вместо 3)

БМВ Модератор Сообщений: 21380 Регистрация: 28.12.2016 Excel 2013, 2016	Апострофф, В чем смысл использовать Split(«20 13 5») вместо Array(20,13,5), та и тот я б вынес за цикл. По вопросам из тем форума, личку не читаю.

Апострофф

Пользователь

Сообщений: 720
Регистрация: 06.04.2015

#12

19.02.2023 10:04:05

БМВ, ARRAY будет быстрее, но вынудит следить за его Bound`ами.
Вынести за цикл — понятно лучше, но лишняя строка и переменная опять же

Код
A=ARRAY(20,13,5) For C = 1 To 18 Columns(C).ColumnWidth = A((C - 1) Mod (UBOUND(A)-LBOUND(A)+1)) Next

Изменено: Апострофф — 19.02.2023 10:28:06

Trambulanga

Пользователь

Сообщений: 21
Регистрация: 11.01.2023

#13

19.02.2023 16:23:34

Ну и в догонку тогда, да простят меня админы, если нужно было создать отдельную тему, но вопрос то капец близкий))
А как с помощью таких же хитрых методов, задать разную высоту строк на листе?
Допустим, есть таблица. Нужно, чтобы каждая 4 строка в этой таблице была высотой 20, а все остальные по 15. Есть реализация? Нашел только вот это.

Код
With Worksheets("Sheet1").Rows(1) .RowHeight = .RowHeight * 2 End With

Но либо для меня не подходит, либо я не туда это прописываю…
Заранее благодарен)

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#14

19.02.2023 16:31:21

Цитата
Trambulanga написал: Нужно, чтобы каждая 4 строка

начиная с какой?
на листе чуть больше 1 млн. строк, каждых 4-х окажется около 250 тыс. всем 250 тыс. строк нужно назначить заданную высоту?

	5, 14, 23, 32 строки. Остальные не нужны

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#16

19.02.2023 17:31:38

Цитата
Trambulanga написал: 5, 14, 23, 32 строки. Остальные не нужны

Цитата
Trambulanga написал: Нужно, чтобы каждая 4 строка

каждая 4-я, говорите))

	Ну да, тупанул( упустил одну пустую строку в таблице, и посчитал, что в каждой таблице это будет 4-ая. Прошу прощения. Ну собственно да, именно те строки, что я указал выше…

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#18

19.02.2023 17:58:34

Код
Rows.RowHeight = 15 for r = 5 to 32 step 9 Rows(r).RowHeight = 20 next

Trambulanga Пользователь Сообщений: 21 Регистрация: 11.01.2023	#19 19.02.2023 18:16:01 Ігор Гончаренко, Благодарю за помощь!

Источник

You can use the following methods to change the width of columns in Excel using VBA:

Method 1: Change Width of One Column

Sub ChangeColumnWidth()
Columns("B").ColumnWidth = 20
End Sub

This particular macro changes the width of column B to 20.

Note: The default width of columns in Excel is 8.29.

Method 2: Change Width of Multiple Columns

Sub ChangeColumnWidth()
Columns("B:D").ColumnWidth = 20
End Sub

This particular macro changes the width of all columns in the range from B to D to 20.

Method 3: Auto Adjust Width of Multiple Columns

Sub ChangeColumnWidth()
Columns("B:D").AutoFit
End Sub

This particular macro automatically adjusts the width of each column in the range from B to D to be as wide as necessary to display the longest cell in each column.

The following examples show how to use each of these methods in practice with the following dataset in Excel:

Example 1: Change Width of One Column

We can create the following macro to change the width of column B to 20:

Sub ChangeColumnWidth()
Columns("B").ColumnWidth = 20
End Sub

When we run this macro, we receive the following output:

Notice that only the width of column B (the “Points” column) has increased to 20 while the width of all other columns remained the same.

Example 2: Change Width of Multiple Columns

We can create the following macro to change the width of columns B through D to 20:

Sub ChangeColumnWidth()
Columns("B:D").ColumnWidth = 20
End Sub

When we run this macro, we receive the following output:

Notice that the width of each column from B to D has increased to 20 while the width of column A remained the same.

Example 3: Auto Adjust Width of Multiple Columns

We can create the following macro to automatically adjust the width of each column from A to D to be as wide as necessary to display the longest cell in each column.

Sub ChangeColumnWidth()
Columns("A:D").AutoFit
End Sub

When we run this macro, we receive the following output:

Notice that the width of each column has automatically been adjusted to be as wide as necessary to display the longest cell in each column.

Additional Resources

The following tutorials explain how to perform other common tasks in VBA:

VBA: How to Count Number of Used Columns
VBA: How to Find Last Used Column
VBA: How to Delete Columns

Источник

В данном примере описаны макросы для автоматического форматирования или спроса формата для ячеек таблиц Excel средствами VBA.

VBA-макрос: заливка, шрифт, линии границ, ширина столбцов и высота строк

В процессе запыления данных сотрудниками отдела на некоторых листах были изменены форматы ячеек:

Необходимо сбросить форматирование ячеек и сделать так чтобы на всех таблицах планов выполнения работ были одинаковые форматы отображения данных. Формат ячеек для исходной таблицы должен быть закреплен за шаблоном, чтобы можно было сделать сброс и применять заданный стиль оформления в дальнейшем.

Чтобы выполнять такие задачи вручную можно попытаться облегчить процесс настройки множества опций форматирования для многих диапазонов ячеек на разных листах и рабочих книгах. Плюс к о всему можно ошибиться и применить несколько другие настройки форматирования.

Макросы Excel прекрасно справляются с форматированием ячеек на рабочих листах. Кроме того, делают это быстро и в полностью автоматическом режиме. Воспользуемся этими преимуществами и для решения данной задачи напишем свой код VBA-макроса. Он поможет нам быстро и безопасно сбрасывать форматы на исходный предварительно заданный в шаблоне главной таблицы.

Чтобы написать свой код макроса откройте специальный VBA-редактор в Excel: «РАЗРАБОТЧИК»-«Код»-«Visual Basic» или нажмите комбинацию клавиш ALT+F11:

В редакторе создайте новый модуль выбрав инструмент «Insert»-«Module» и введите в него такой VBA-код макроса:

Sub SbrosFormat() If TypeName(Selection) <> "Range" Then Exit Sub With Selection .HorizontalAlignment = xlVAlignCenter .VerticalAlignment = xlVAlignCenter .WrapText = True .Borders.LineStyle = xlContinuous .Borders.Weight = xlThin .Font.ColorIndex = xlColorIndexAutomatic .Interior.ColorIndex = xlColorIndexAutomatic .Columns.AutoFit .Rows.AutoFit End With End Sub

Теперь если нам нужно сбросить форматирование таблицы на исходный формат отображения ее данных, выделите диапазон ячеек A1:E20 и запустите макрос: «РАЗРАБОЧТИК»-«Код»-«Макросы»-«SbrosFormat»-«Выполнить». Результат работы макроса изображен ниже на рисунке:

Таблица приобрела формат, который определен макросом. Таким образом код VBA нам позволяет сбросить любые изменения формата ячеек на предустановленный автором отчета.

Описание VBA-макроса для формата ячеек таблицы Excel

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

Текст в значениях ячеек выравнивается по центру горизонтально и вертикально.
Включен построчный перенос текста.
Все границы ячеек получают черную обычной толщины непрерывную линию с черным цветом.
Сброс цвета шрифта на авто.
Удаляется любая заливка ячеек.
Ширина столбцов автоматически настраивается под текст в ячейках.
Автоматически настроить высоту строк по содержимому ячеек.

Модификация исходного кода макроса для форматирования

Если необходимо сделать так чтобы текст выравнивался не по центру относительно горизонтали, а по правую сторону ячейки, тогда измените константу xlHAlignCenter на xlHAlignRight. Она находиться в свойстве .HorizontalAlignment. Сделайте это следующим образом:

.HorizontalAlignment = xlHAlignRight.

Таким же образом можно выровнять текст по левую сторону изменив значение константы на xlHAlignLeft. Или можно выровнять положение текста по ширине ячейки используя константу xlHAlignJustify.

Чтобы макрос выравнивал текст в ячейках по вертикали к низу, измените строку кода, отвечающую за данную настройку форматирования. Измените константу, которая присваивается к свойству VerticalAlignment в следующий способ:

Если хотите выровнять текс к верху ячейки, тогда воспользуйтесь константой xlHAlignTop.

Если нужно применить для границ ячеек толстую и пунктирную линию в синем цвете, смодифицируйте инструкцию, отвечающую за формат линий:

.Borders.LineStyle = xlDash

.Borders.Color = vbBlue

.Borders.Weight = xlMedium

Описание настройки форматирования для линий границ ячеек. Мы будем получать разные дополнительные типы линий границ если для свойства LineStyle присваивать такие константы:

xlDoshDot – применяется для рисования пунктирных линий в границах ячеек;
xlDouble – рисует двойную линию;
xlHairLine – рисует тонкую линию;
xlThick – для рисования очень толстой линии.

Для настройки цвета линий Excel предлагает всего 8 констант для определенных цветов. Константы для настройки цвета линий границ для свойства Color:

vbBlack – черный;
vbWhite – белый;
vbRed – красный;
vbGreen –зеленый;
vbBlue – синий;
vbYellow – желтый;
vbMagenta – алый;
vbCyan – голубой.

Но при необходимости присвоить линиям границ другие цвета можно вместо константы для свойства Color записать функцию RGB(). Достаточно лишь в аргументе этой функции указать код цвета по шкале от 0 и до 255.

Если нужно применить толстую линию только для границ выделенного диапазона, тогда перед инструкцией End With добавьте следующую строку кода:

.BorderAround xlContinuous, xlMedium, vbBlack

Описание: В первом аргументе для метода BorderAround можно записать также другой стиль линии. Во втором – толщину линии, а в третьем – цвет. Константы, которые можно присвоить в качестве значений для этих аргументов можно использовать те же, которые мы использовали для свойств: LineStyle, Weight, Color.

Если нужно экспонировать первую строку для выделенного диапазона с помощью жирного и курсивного шрифта значений ячеек. А также заполнить ячейки первой строки заливкой с голубым цветом, тогда в самом конце кода макроса перед последней инструкцией End Sub следует добавить несколько строк с VBA-кодом:

.Rows(1).Font.Bold = True

.Rows(1).Font.Italic = True

.Rows(1).Interior.Color = vbCyan

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

.Columns (1).Font.Bold = True

.Columns (1).Font.Italic = True

.Columns (1).Interior.Color = vbCyan

Если нужно задать особенный формат для экспонирования последней строки выделенного диапазона, тогда измените число 1 в аргументе свойства Rows на число всех выделенных строк .Rows.Count. Например, добавьте в конец кода еще такую строку:

.Rows(.Rows.Count).Font.Bold = True

Полная версия модифицированного кода макроса выглядит так:

Sub SbrosFormat() If TypeName(Selection) <> "Range" Then Exit Sub With Selection .HorizontalAlignment = xlVAlignCenter .VerticalAlignment = xlVAlignCenter .WrapText = True .Borders.LineStyle = xlDash .Borders.Color = vbBlue .Borders.Weight = xlMedium .Font.ColorIndex = xlColorIndexAutomatic .Interior.ColorIndex = xlColorIndexAutomatic .Columns.AutoFit .Rows.AutoFit .BorderAround xlContinuous, xlMedium, vbBlack .Rows(1).Font.Bold = True .Rows(1).Font.Italic = True .Rows(1).Interior.Color = vbCyan .Columns(1).Font.Bold = True .Columns(1).Font.Italic = True .Columns(1).Interior.Color = vbCyan .Rows(.Rows.Count).Font.Bold = True End With End Sub

Пример работы измененного кода VBA-макроса:

В данном примере вы ознакомились с базовыми возможностями форматирования с помощью VBA-макросов. Уверен, что теперь вы сможете самостоятельно найти практическое применение этим исходным кодам.

Источник