Скопировать подзаголовки в отдельную колонку (с текст знач)

Старая форма входа

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

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Скопировать подзаголовки в отдельную колонку (с текст знач) (Формулы/Formulas)

Rip141

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

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

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

Сообщений: 2

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

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

Excel 2010

Здравствуйте,
задача приведена в приложенном файле.
Поправила условия: и заголовки и содержание колонок текстовые и самые разнообразные. Количество строк после каждого подзаголовка тоже постоянно меняется.

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

Ответить

_Boroda_

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

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

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

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

Если все так, как у Вас в файле (я про выравнивание), то можно так

Код

=ЕСЛИ(ЯЧЕЙКА("префикс";A5)="'";A5;B4)

К сообщению приложен файл: primer-16-1.xls (38.5 Kb)

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

Ответить

Nic70y

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

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

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

Сообщений: 8761

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

Замечаний: 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 c.Interior.Color = 65535 And c.Offset(0, 1) = "" Then c.Offset(1, 1) = c.Value
        'If c.Interior.Color <> 65535 And c.Offset(0, 1) = "" Then c.Offset(0, 1) = c.Offset(-1, 1).Value
        If c.HorizontalAlignment <> xlRight And c.Offset(0, 1) = "" Then c.Offset(1, 1) = c.Value
        If c.HorizontalAlignment = xlRight 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]

К сообщению приложен файл: primer-1-.xls (45.5 Kb)

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Вторник, 28.11.2017, 13:52

Ответить

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