Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Разбивка данных в столбце по строкам - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Разбивка данных в столбце по строкам
pinkvin Дата: Среда, 15.05.2024, 07:28 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Доброго времени суток.
В Экселе есть данные о улицах и домах на этой улице.
Дома на каждой улице указаны в одной ячейке через запятую.
Подскажите пожалуйста можно ли их разделить автоматически как указал в примере ?
Желательно с помощью макроса, потому что такие типовые задачи будут частым явлением :)
К сообщению приложен файл: 4086355.xlsx (9.2 Kb)


Сообщение отредактировал pinkvin - Среда, 15.05.2024, 07:59
 
Ответить
СообщениеДоброго времени суток.
В Экселе есть данные о улицах и домах на этой улице.
Дома на каждой улице указаны в одной ячейке через запятую.
Подскажите пожалуйста можно ли их разделить автоматически как указал в примере ?
Желательно с помощью макроса, потому что такие типовые задачи будут частым явлением :)

Автор - pinkvin
Дата добавления - 15.05.2024 в 07:28
китин Дата: Среда, 15.05.2024, 08:09 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 7021
Репутация: 1075 ±
Замечаний: 0% ±

Excel 2007;2010;2016
PQ всемогущий
К сообщению приложен файл: pinkvin.xlsx (19.1 Kb)


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
 
Ответить
СообщениеPQ всемогущий

Автор - китин
Дата добавления - 15.05.2024 в 08:09
Nic70y Дата: Среда, 15.05.2024, 09:00 | Сообщение № 3
Группа: Друзья
Ранг: Экселист
Сообщений: 8887
Репутация: 2324 ±
Замечаний: 0% ±

Excel 2010
макрос
[vba]
Код
Sub u_4()
    Application.ScreenUpdating = False
    'сотрем старую таблицу
    x = Cells(Rows.Count, "h").End(xlUp).Row
    If x > 1 Then Range("h2:i" & x).Clear
    'составим новую
    a = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя строка столбца A
    For b = 2 To a 'цикл от 2 до нижней строки
        c = Range("b" & b).Value 'значение ячейки столбца B
        d = Len(c) 'кол-во символов в ячейке
        e = Len(Replace(c, ",", "")) 'кол-во символов без запятых
        f = d - e + 1 'кол-во номеров домов
        g = Range("a" & b).Value 'улица
        c = c & ","
        For h = 1 To f 'цикл по кол-ву домов
            i = InStr(c, ",") 'ищем запятую
            j = Trim(Left(c, i - 1)) 'дом
            If IsNumeric(j) = False Then j = "'" & j
            c = Mid(c, i + 1, d) 'значение ячейки со след. дома
            k = Cells(Rows.Count, "h").End(xlUp).Row + 1 'строка вставки
            Range("h" & k) = g
            Range("i" & k) = j
        Next
    Next
    With Range("h2:i" & k)
        .Borders.LineStyle = xlContinuous 'границы
        .HorizontalAlignment = xlCenter 'текс по центру
    End With
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 4086355.xlsm (18.9 Kb)


ЮMoney 41001841029809
 
Ответить
Сообщениемакрос
[vba]
Код
Sub u_4()
    Application.ScreenUpdating = False
    'сотрем старую таблицу
    x = Cells(Rows.Count, "h").End(xlUp).Row
    If x > 1 Then Range("h2:i" & x).Clear
    'составим новую
    a = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя строка столбца A
    For b = 2 To a 'цикл от 2 до нижней строки
        c = Range("b" & b).Value 'значение ячейки столбца B
        d = Len(c) 'кол-во символов в ячейке
        e = Len(Replace(c, ",", "")) 'кол-во символов без запятых
        f = d - e + 1 'кол-во номеров домов
        g = Range("a" & b).Value 'улица
        c = c & ","
        For h = 1 To f 'цикл по кол-ву домов
            i = InStr(c, ",") 'ищем запятую
            j = Trim(Left(c, i - 1)) 'дом
            If IsNumeric(j) = False Then j = "'" & j
            c = Mid(c, i + 1, d) 'значение ячейки со след. дома
            k = Cells(Rows.Count, "h").End(xlUp).Row + 1 'строка вставки
            Range("h" & k) = g
            Range("i" & k) = j
        Next
    Next
    With Range("h2:i" & k)
        .Borders.LineStyle = xlContinuous 'границы
        .HorizontalAlignment = xlCenter 'текс по центру
    End With
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 15.05.2024 в 09:00
pinkvin Дата: Среда, 15.05.2024, 09:53 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Nic70y, спасибо, всё работает!
Не уточнил правда, что у улицы может быть один дом, но такие строки макрос не растерял.
 
Ответить
СообщениеNic70y, спасибо, всё работает!
Не уточнил правда, что у улицы может быть один дом, но такие строки макрос не растерял.

Автор - pinkvin
Дата добавления - 15.05.2024 в 09:53
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!