Разделить данные в нескольких ячейках на строки - VBA

Узнай цену своей работы

Формулировка задачи:

Добрый день! Пожалуйста помогите, решить следующую проблему: Есть таблица с данными, в которой в 2-х ячейках есть данные разделенные с помощью ;" Необходимо выделить данные из ячеек в строки ниже с копированием информации из других ячеек Например: [Номер][Строка][Персона1;Персона2;Персона3][Документ1;Документ2;Документ3] нужно привести к следующему виду: [Номер][Строка][Персона1][Документ1] [Номер][Строка][Персона2][Документ2] [Номер][Строка][Персона3][Документ3] Пример в прикрепленном файле (извините за неудобный вид, пришлось скрыть личные данные), отвечу на любые вопросы. Буду очень благодарен за помощь.

Решение задачи: «Разделить данные в нескольких ячейках на строки»

textual
Листинг программы
Option Explicit
 
Sub qwert()
Dim r!, c!, m(), lr!, lc!, rn!, c1!, c2!, rz(), ri!, u1, u2, ii
c1 = 7 '
c2 = 8 '
With Лист1
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
    m = .[a1].Resize(lr, lc).Value
    For r = 1 To UBound(m): lr = lr + UBound(Split(m(r, c1), ";")): Next
    ReDim rz(1 To lr, 1 To lr)
    For r = 1 To UBound(m)
        If InStr(1, m(r, c1), ";") > 0 Then
            u1 = Split(m(r, c1), ";")
            u2 = Split(m(r, c2), ";")
            If UBound(u1) <> UBound(u2) Then MsgBox "В строке " & r & " несоответсвие", vbCritical, ""
            For ii = 0 To UBound(u1)
                If Len(u1(ii)) > 0 Then
                    ri = ri + 1
                    For c = 1 To lc
                        rz(ri, c) = m(r, c)
                    Next c
                    rz(ri, c1) = u1(ii)
                    rz(ri, c2) = u2(ii)
                End If
            Next ii
        Else
            ri = ri + 1
            For c = 1 To lc
                rz(ri, c) = m(r, c)
            Next c
        End If
    Next r
    .[a1].Resize(lr, lc) = rz
End With
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

8   голосов , оценка 3.625 из 5
Похожие ответы