Как скопировать подзаголовки в таблице в отдельную колонку

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

Как скопировать подзаголовки в таблице в отдельную колонку (Формулы/Formulas)

Rip141

Дата: Вторник, 28.11.2017, 10:11 | Сообщение № 1

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

Ранг: Прохожий

Сообщений: 2

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

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

Excel 2010

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

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

Ответить

_Boroda_

Дата: Вторник, 28.11.2017, 10:26 | Сообщение № 2

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

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

Сообщений: 16885

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Так нужно? (в соседний столбец)

Код

=ЕСЛИ(Ч(A5);B4;A5)

Если числа могут быть нулями

Код

=ЕСЛИ(ЕЧИСЛО(A5);B4;A5)

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

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

Ответить

Nic70y

Дата: Вторник, 28.11.2017, 14:24 | Сообщение № 3

Группа: Друзья

Ранг: Экселист

Сообщений: 9130

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

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

Excel 2010

or
[vba]

Код

Sub u_724()
    Application.ScreenUpdating = False
    u = Cells(Rows.Count, 1).End(xlUp).Row
    Range("b5:b" & u).Clear
    For Each c In Range("a5:a" & u)
        If Application.IsText(c) = True And c.Offset(0, 1) = "" Then c.Offset(1, 1) = c.Value
        If Application.IsText(c) = False And c.Offset(0, 1) = "" Then c.Offset(0, 1) = c.Offset(-1, 1).Value
    Next
    'With Range("b5:b" & u)
        '.HorizontalAlignment = xlGeneral
        '.VerticalAlignment = xlBottom
        '.WrapText = True
    'End With
    Range("b5:b" & u).Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("b5:b" & u).Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("b5:b" & u).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("b5:b" & u).Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("b5:b" & u).Borders(xlInsideVertical).LineStyle = xlContinuous
    Range("b5:b" & u).Borders(xlInsideHorizontal).LineStyle = xlContinuous
    Application.ScreenUpdating = True
End Sub

[/vba]

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

ЮMoney 41001841029809

Ответить

ВладимирG

Дата: Четверг, 30.11.2017, 10:50 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 136

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

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

2007

or
[vba]

Код

Sub GroupText()
Dim lstr&, lev As Range, r As Range
Application.ScreenUpdating = False
lstr = Cells(Rows.Count, 1).End(xlUp).Row
Set lev = Range("A5:A" & lstr).SpecialCells(2, 1)
For Each r In lev.SpecialCells(2).Areas
Cells(r.Row, 2).Resize(r.Rows.Count) = Cells(r.Row - 1, 1)
Next
Application.ScreenUpdating = True
End Sub

[/vba]

Ответить

_Boroda_

Дата: Четверг, 30.11.2017, 11:06 | Сообщение № 5

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

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

Сообщений: 16885

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

ищио or
без циклов
[vba]

Код

Sub Shapki()
    Application.ScreenUpdating = 0
    r1_ = Range("A" & Rows.Count).End(xlUp).Row
    Range("A5:A" & r1_).Copy Range("B5")
    With Range("B5:B" & r1_).SpecialCells(2, 1)
        .ClearContents
        .FormulaR1C1 = "=R[-1]C"
    End With
    Range("B5:B" & r1_) = Range("B5:B" & r1_).Value
    Application.ScreenUpdating = 1
End Sub

[/vba]

Ответить

Как скопировать подзаголовки в таблице в отдельную колонку (Формулы/Formulas)

Страница 1 из 1
1