Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос: Разбивка данных ячеек с разделителем по строкам
 
Добрый день, уважаемые форумчане.
Прошу помощи.
Имеется выгрузка из БД в таблицу, в которой в столбцах 2 и 3 через разделитель (запятая) перечислены ФИО и статусы.
В столбцах 1 и 4 другие данные, относящиеся ко всем ФИО и статусам.

В итоге нужно получить разбивку данных по строкам, чтобы можно было отследить у какой ФИО какой статус, используя фильтр по определенному статусу..
В примере привел два итоговых варианта:
1. С объединенными ячейками оставшихся столбцов
2. С копированием данных ячеек оставшихся столбцов.

В исходном файле столбцов и строк с данными очень много.
 
Доброе время суток.
Версия варианта №2 на Power Query.
 
Спасибо большое!
Но не совсем понял как Вы это сделали - в Power Query разбивается только один столбец. При делении второго у меня получается ерунда.
Можете объяснить, пожалуйста?

В идеале хотелось бы сделать именно макрос, чтобы можно было использовать на старом MS office 2010
 
Код
Sub мяу()
    Dim sh As Worksheet, sh1 As Worksheet, lr&, i&, ii&, spl, spl1
    Set sh = ActiveSheet
    Set sh1 = Worksheets.Add
    lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
    sh.Range("A1").Resize(, 4).Copy sh1.Range("A1")
    ii = 2
    For i = 2 To lr
        spl = Split(sh.Cells(i, 2), ",")
        spl1 = Split(sh.Cells(i, 3), ",")
        sh1.Cells(ii, 1).Resize(UBound(spl) + 1).Merge
        sh1.Cells(ii, 1) = sh.Cells(i, 1)
        sh1.Cells(ii, 2).Resize(UBound(spl) + 1) = Application.Transpose(spl)
        sh1.Cells(ii, 3).Resize(UBound(spl) + 1) = Application.Transpose(spl1)
        sh1.Cells(ii, 4).Resize(UBound(spl) + 1).Merge
        sh1.Cells(ii, 4) = sh.Cells(i, 4)
        ii = sh1.Cells(Rows.Count, 2).End(xlUp).Row + 1
    Next
End Sub
 
Цитата
kassar90 написал:
При делении второго у меня получается ерунда.
Покажите это в выложенном мной файле. Для 2010, 2013 Power Query существует как надстройка. Можно скачать и установить.

Тёзка, а если массивы двух Split будут иметь разную длину?
Изменено: Андрей VG - 15 Мар 2019 06:40:01
 
Код
Sub TextToRows()
Dim arr(), arrNew(), u&, i&, n1&, n2&, n&, j&
Dim iStr1, iStr2
With Worksheets("Как есть")
    arr = .Range("A2:D" & .Cells(Rows.Count, "B").End(xlUp).Row).Value
End With
u = UBound(arr) * UBound(Split(arr(1, 2), ",")) * 2
ReDim arrNew(1 To u, 1 To 4): u = 1
For i = 1 To UBound(arr)
    iStr1 = Split(arr(1, 2), ","): n1 = UBound(iStr1)
    iStr2 = Split(arr(1, 3), ","): n2 = UBound(iStr2)
    n = IIf(n1 > n2, n1, n2)
    For j = 0 To n
        arrNew(u, 1) = arr(i, 1)
        If n1 < j Then arrNew(u, 2) = Empty Else arrNew(u, 2) = Trim(iStr1(j))
        If n2 < j Then arrNew(u, 3) = Empty Else arrNew(u, 3) = Trim(iStr2(j))
        arrNew(u, 4) = arr(i, 4)
        u = u + 1
    Next
Next
Worksheets("Как есть").Range("F2").Resize(u, 4) = arrNew
End Sub

Думаю 'Как надо (вариант 2)' будет предпочтительней для дальнейшей работы с данными и с учетом замечания от Андрей VG,
Цитата
Андрей VG написал: а если массивы двух Split будут иметь разную длину?
Изменено: Sanja - 15 Мар 2019 08:14:48
Согласие есть продукт при полном непротивлении сторон.
 
Цитата
Андрей VG написал:
а если массивы двух Split будут иметь разную длину?
то это будет кривой исходник, и правильно его обработать не получится никаким способом
 
kassar90, Ностальгия… Одна из первых моих тем
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
Страницы: 1
Читают тему (гостей: 1)
Наверх