Разный размер текста внутри одной ячейки Excel

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Разный размер текста внутри одной ячейки Excel (Формулы/Formulas)

bagraart

Дата: Пятница, 15.06.2018, 11:24 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 35

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Товарищи, приветствую,

Имеется файл (во вложении), в котором в ячейке A1 "текст" - 01.001.001.01 разного размера. А именно: 01.001 - Calibri 26, a .001.01 - Calibri 42.

Есть ли некий макрос, или как можно разом все ячейки листа заставить быть похожими на ячейку А1 (без чета цвета, просто имея разно-размерность текста внутри одной ячейки)

Заранее благодарю!

К сообщению приложен файл: 4087699.xls (23.5 Kb)

Ответить

SLAVICK

Дата: Пятница, 15.06.2018, 11:46 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата bagraart, 15.06.2018 в 11:24, в сообщении № 1 ()

некий макрос, или как можно разом все ячейки листа заставить быть похожими на ячейку А1

[vba]

Код

Sub Макрос1()
Dim MainCell As Range, Cell As Range, n%
Set MainCell = Range("A1")

For Each Cell In ActiveSheet.UsedRange
    If Cell.Address = MainCell.Address Then n = 0 Else n = IIf(Len(MainCell) >= Len(Cell), Len(Cell), Len(MainCell))
    For i = 1 To n
        Cell.Characters(Start:=i, Length:=1).Font.Name = MainCell.Characters(Start:=i, Length:=1).Font.Name
        Cell.Characters(Start:=i, Length:=1).Font.Size = MainCell.Characters(Start:=i, Length:=1).Font.Size
    Next
Next
End Sub

[/vba]

К сообщению приложен файл: 7647421.xls (35.0 Kb)

Иногда все проще чем кажется с первого взгляда.

Ответить

_Boroda_

Дата: Пятница, 15.06.2018, 11:48 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 16888

Репутация: 6611 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

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

Цитата bagraart, 15.06.2018 в 11:24, в сообщении № 1 ()

01.001 - Calibri 26, a .001.01 - Calibri 42

То можно не морочить голову со считыванием размера и названия шрифта из А1, а просто написать вот так
[vba]

Код

Sub PerenosRazm()
    Dim d_ As Range, d0_ As Range
    Set d_ = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    For Each d0_ In d_
        With d0_
            .Font.Name = "Calibri"
            .Characters(Start:=1, Length:=6).Font.Size = 26
            .Characters(Start:=7, Length:=7).Font.Size = 42
        End With
    Next d0_
End Sub

[/vba]
*Если в ячейке А1 сломается формат, то просто запустите этот макрос еще раз

К сообщению приложен файл: 4087699_1.xls (31.0 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

StoTisteg

Дата: Пятница, 15.06.2018, 11:57 | Сообщение № 4

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

[vba]

Код

Sub Макрос3()

   Dim cell As Range

   For Each cell In ActiveSheet.UsedRange
      cell.Characters(Start:=1, Length:=6).Font.Size = 26
      cell.Characters(Start:=7, Length:=7).Font.Size = 42
   Next cell

End Sub

[/vba]

К сообщению приложен файл: 8399402.xlsm (17.0 Kb)

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

bagraart

Дата: Пятница, 15.06.2018, 12:00 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 35

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Цитата _Boroda_, 15.06.2018 в 11:48, в сообщении № 3 ()

Спасибо большое ребята!

Все получилось.

А можно поинтересоваться, для саморазвития, а если бы мне хотелось еще и учесть цвет залики, цвет текста, выравнивания, жирности, подчеркивания..... как в комментарии Boroda, то как бы изменился макрос?

Ну т.е. если бы задача была: как можно разом все ячейки листа заставить быть похожими на ячейку А1, с учетом всех форматирований этой ячейки

Ответить

StoTisteg

Дата: Пятница, 15.06.2018, 12:04 | Сообщение № 6

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

bagraart, а Вы просто запишите это действие макрорекордером. Он Вам туда всё вообще закинет

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

StoTisteg

Дата: Пятница, 15.06.2018, 12:06 | Сообщение № 7

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Цитата bagraart, 15.06.2018 в 12:00, в сообщении № 5 ()

с учетом всех форматирований этой ячейки

Не нужен макрос, это просто спецвставкой форматов достигается. Макрос нужен только для шрифтов, такое спецвставка не умеет.

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

SLAVICK

Дата: Пятница, 15.06.2018, 12:11 | Сообщение № 8

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата bagraart, 15.06.2018 в 12:00, в сообщении № 5 ()

еще и учесть цвет залики, цвет текста, выравнивания, жирности, подчеркивания...

[vba]

Код

Sub Макрос1()
Dim MainCell As Range, Cell As Range, n%
Set MainCell = Range("A1")
'скопировать формат ячейки целиком:
    MainCell.Copy
    ActiveSheet.UsedRange.PasteSpecial xlPasteFormats
'Применить посимвольный формат
For Each Cell In ActiveSheet.UsedRange
    If Cell.Address = MainCell.Address Then n = 0 Else n = IIf(Len(MainCell) >= Len(Cell), Len(Cell), Len(MainCell))
    For i = 1 To n

        Cell.Characters(Start:=i, Length:=1).Font.Name = MainCell.Characters(Start:=i, Length:=1).Font.Name
        Cell.Characters(Start:=i, Length:=1).Font.Bold = MainCell.Characters(Start:=i, Length:=1).Font.Bold
        Cell.Characters(Start:=i, Length:=1).Font.Size = MainCell.Characters(Start:=i, Length:=1).Font.Size
        Cell.Characters(Start:=i, Length:=1).Font.FontStyle = MainCell.Characters(Start:=i, Length:=1).Font.FontStyle
        Cell.Characters(Start:=i, Length:=1).Font.Strikethrough = MainCell.Characters(Start:=i, Length:=1).Font.Strikethrough
        Cell.Characters(Start:=i, Length:=1).Font.Superscript = MainCell.Characters(Start:=i, Length:=1).Font.Superscript
        Cell.Characters(Start:=i, Length:=1).Font.OutlineFont = MainCell.Characters(Start:=i, Length:=1).Font.OutlineFont
        Cell.Characters(Start:=i, Length:=1).Font.Shadow = MainCell.Characters(Start:=i, Length:=1).Font.Shadow
        Cell.Characters(Start:=i, Length:=1).Font.Underline = MainCell.Characters(Start:=i, Length:=1).Font.Underline
        Cell.Characters(Start:=i, Length:=1).Font.Color = MainCell.Characters(Start:=i, Length:=1).Font.Color
        Cell.Characters(Start:=i, Length:=1).Font.TintAndShade = MainCell.Characters(Start:=i, Length:=1).Font.TintAndShade
        Cell.Characters(Start:=i, Length:=1).Font.ThemeFont = MainCell.Characters(Start:=i, Length:=1).Font.ThemeFont
    Next
Next
End Sub

[/vba]

Цитата bagraart, 15.06.2018 в 12:00, в сообщении № 5 ()

еще и учесть цвет залики, цвет текста, выравнивания, жирности, подчеркивания...

[vba]

Код