Блог

Главная - Вопросы по программированию - Разделить значения ячеек на несколько строк и сохранить другие данные

Разделить значения ячеек на несколько строк и сохранить другие данные

#excel #vba #parsing

#excel #vba

Вопрос:

У меня есть значения в столбце B, разделенные запятыми. Мне нужно разделить их на новые строки и сохранить остальные данные такими же.

У меня переменное количество строк.

Я не знаю, сколько значений будет в ячейках в столбце B, поэтому мне нужно динамически перебирать массив.

Пример:

 ColA       ColB       ColC      ColD
Monday     A,B,C      Red       Email

Вывод:

 ColA       ColB       ColC      ColD
Monday       A         Red       Email
Monday       B         Red       Email
Monday       C         Red       Email

Пробовали что-то вроде:

 colArray = Split(ws.Cells(i, 2).Value, ", ")
For i = LBound(colArray) To UBound(colArray)
    Rows.Insert(i)
Next i

Ответ №1:

Попробуйте это, вы можете легко настроить его в соответствии с вашим фактическим именем листа и разделяемым столбцом.

 Sub splitByColB()
    Dim r As Range, i As Long, ar
    Set r = Worksheets("Sheet1").Range("B999999").End(xlUp)
    Do While r.row > 1
        ar = Split(r.value, ",")
        If UBound(ar) >= 0 Then r.value = ar(0)
        For i = UBound(ar) To 1 Step -1
            r.EntireRow.Copy
            r.Offset(1).EntireRow.Insert
            r.Offset(1).value = ar(i)
        Next
        Set r = r.Offset(-1)
    Loop
End Sub

Ответ №2:

Вы также можете просто сделать это на месте, используя Do цикл вместо For цикла. Единственный реальный трюк — просто вручную обновлять счетчик строк каждый раз, когда вы вставляете новую строку. «Статические» столбцы, которые копируются, — это просто вопрос кэширования значений и последующей записи их во вставленные строки:

 Dim workingRow As Long
workingRow = 2
With ActiveSheet
    Do While Not IsEmpty(.Cells(workingRow, 2).Value)
        Dim values() As String
        values = Split(.Cells(workingRow, 2).Value, ",")
        If UBound(values) > 0 Then
            Dim colA As Variant, colC As Variant, colD As Variant
            colA = .Cells(workingRow, 1).Value
            colC = .Cells(workingRow, 3).Value
            colD = .Cells(workingRow, 4).Value
            For i = LBound(values) To UBound(values)
                If i > 0 Then
                    .Rows(workingRow).Insert xlDown
                End If
                .Cells(workingRow, 1).Value = colA
                .Cells(workingRow, 2).Value = values(i)
                .Cells(workingRow, 3).Value = colC
                .Cells(workingRow, 4).Value = colD
                workingRow = workingRow   1
            Next
        Else
            workingRow = workingRow   1
        End If
    Loop
End With

Комментарии:

1. Молодец, Коминтерн!!

Ответ №3:

Это сделает то, что вы хотите.

 Option Explicit

Const ANALYSIS_ROW As String = "B"
Const DATA_START_ROW As Long = 1

Sub ReplicateData()
    Dim iRow As Long
    Dim lastrow As Long
    Dim ws As Worksheet
    Dim iSplit() As String
    Dim iIndex As Long
    Dim iSize As Long

    'Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook
        .Worksheets("Sheet4").Copy After:=.Worksheets("Sheet4")
        Set ws = ActiveSheet
    End With

    With ws
        lastrow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row
    End With


    For iRow = lastrow To DATA_START_ROW Step -1
        iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ",")
        iSize = UBound(iSplit) - LBound(iSplit)   1
        If iSize = 1 Then GoTo Continue

        ws.Rows(iRow).Copy
        ws.Rows(iRow).Resize(iSize - 1).Insert
        For iIndex = LBound(iSplit) To UBound(iSplit)
            ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex)
        Next iIndex
Continue:
    Next iRow

    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    'Application.ScreenUpdating = True
End Sub

Ответ №4:

Решение формулы близко к вашим требованиям.

Изображение показано здесь.

Ячейка G1 является разделителем. В данном случае запятая.

 Helper E1:=SUM(E1,LEN(B1)-LEN(SUBSTITUTE(B1,$H$1,""))) 1

Вы должны заполнить приведенную выше формулу на одну строку больше.

 A8:=a1

Заполните эту формулу справа.

 A9:=LOOKUP(ROW(1:1),$E:$E,A:A)amp;""

Заполните эту формулу справа, а затем вниз.

 B9:=MID($H$1amp;LOOKUP(ROW(A1),E:E,B:B)amp;$H$1,FIND("艹",SUBSTITUTE($H$1amp;LOOKUP(ROW(A1),E:E,B:B)amp;$H$1,$H$1,"艹",ROW(A2)-LOOKUP(ROW(A1),E:E))) 1,FIND("艹",SUBSTITUTE($H$1amp;LOOKUP(ROW(A1),E:E,B:B)amp;$H$1,$H$1,"艹",ROW(A2)-LOOKUP(ROW(A1),E:E) 1))-FIND("艹",SUBSTITUTE($H$1amp;LOOKUP(ROW(A1),E:E,B:B)amp;$H$1,$H$1,"艹",ROW(A2)-LOOKUP(ROW(A1),E:E)))-1)amp;""

Заполните.

Ошибка:

Числа будут преобразованы в текст. Конечно, вы можете удалить amp;»» в конце формулы, но пустые ячейки будут заполнены 0.

Ответ №5:

Учитывая превосходный и краткий ответ @ A.S.H., приведенная ниже функция VBA может быть немного излишней, но, надеюсь, она поможет кому-то, кто ищет более «общее» решение. Этот метод гарантирует, что не будут изменены ячейки слева, справа или над таблицей данных, в случае, если таблица не начинается с A1 или в случае, если на листе помимо таблицы есть другие данные. Это также позволяет избежать копирования и вставки целых строк и позволяет указать разделитель, отличный от запятой.

Эта функция имеет сходство с процедурой @ryguy72, но она не зависит от буфера обмена.

 Function SplitRows(ByRef dataRng As Range, ByVal splitCol As Long, ByVal splitSep As String, _
                   Optional ByVal idCol As Long = 0) As Boolean
  SplitRows = True

  Dim oldUpd As Variant: oldUpd = Application.ScreenUpdating
  Dim oldCal As Variant: oldCal = Application.Calculation

  On Error GoTo err_sub

  'Modify application settings for the sake of speed
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  'Get the current number of data rows
  Dim rowCount As Long: rowCount = dataRng.Rows.Count

  'If an ID column is specified, use it to determine where the table ends by finding the first row
  '  with no data in that column
  If idCol > 0 Then
    With dataRng
      rowCount = .Offset(, idCol - 1).Resize(, 1).End(xlDown).Row - .Row   1
    End With
  End If

  Dim splitArr() As String
  Dim splitLb As Long, splitUb As Long, splitI As Long
  Dim editedRowRng As Range

  'Loop through the data rows to split them as needed
  Dim r As Long: r = 0
  Do While r < rowCount
    r = r   1

    'Split the string in the specified column
    splitArr = Split(dataRng.Cells(r, splitCol).Value amp; "", splitSep)
    splitLb = LBound(splitArr)
    splitUb = UBound(splitArr)

    'If the string was not split into more than 1 item, skip this row
    If splitUb <= splitLb Then GoTo splitRows_Continue

    'Replace the unsplit string with the first item from the split
    Set editedRowRng = dataRng.Resize(1).Offset(r - 1)
    editedRowRng.Cells(1, splitCol).Value = splitArr(splitLb)

    'Create the new rows
    For splitI = splitLb   1 To splitUb
      editedRowRng.Offset(1).Insert 'Add a new blank row
      Set editedRowRng = editedRowRng.Offset(1) 'Move down to the next row
      editedRowRng.Offset(-1).Copy Destination:=editedRowRng 'Copy the preceding row to the new row
      editedRowRng.Cells(1, splitCol).Value = splitArr(splitI) 'Place the next item from the split string

      'Account for the new row in the counters
      r = r   1
      rowCount = rowCount   1
    Next

splitRows_Continue:
  Loop

exit_sub:
  On Error Resume Next

  'Resize the original data range to reflect the new, full data range
  If rowCount <> dataRng.Rows.Count Then Set dataRng = dataRng.Resize(rowCount)

  'Restore the application settings
  If Application.ScreenUpdating <> oldUpd Then Application.ScreenUpdating = oldUpd
  If Application.Calculation <> oldCal Then Application.Calculation = oldCal
  Exit Function

err_sub:
  SplitRows = False
  Resume exit_sub
End Function

Функция ввода и вывода

Чтобы использовать вышеуказанную функцию, вы должны указать

  • диапазон, содержащий строки данных (исключая заголовок)
  • (относительный) номер столбца в диапазоне со строкой для разделения
  • разделитель в строке для разделения
  • необязательный (относительный) номер столбца «ID» в пределах диапазона (если указано число > = 1, первая строка без данных в этом столбце будет принята за последнюю строку данных)

Объект range, переданный в первом аргументе, будет изменен функцией, чтобы отразить диапазон всех новых строк данных (включая все вставленные строки). Функция возвращает True, если ошибок не обнаружено, и False в противном случае.

Примеры

Для диапазона, показанного в исходном вопросе, вызов будет выглядеть следующим образом:

 SplitRows Range("A2:C2"), 2, ","

Если бы одна и та же таблица начиналась с F5 вместо A1, и если бы данные в столбце G (т. Е. Данные, Которые попали бы в столбец B, если бы таблица начиналась с A1) Были разделены символами Alt-Enter вместо запятых, вызов выглядел бы так:

 SplitRows Range("F6:H6"), 2, vbLf

Если бы таблица содержала заголовок строки плюс 10 строк данных (вместо 1), и если бы она снова начиналась с F5, вызов выглядел бы так:

 SplitRows Range("F6:H15"), 2, vbLf

Если не было уверенности в количестве строк, но мы знали, что все допустимые строки являются смежными и всегда имеют значение в столбце H (т. Е. 3-й столбец в диапазоне), Вызов может выглядеть примерно так:

 SplitRows Range("F6:H1048576"), 2, vbLf, 3

В Excel 95 или ниже вам нужно будет изменить «1048576» на «16384», а в Excel 97-2003 на «65536».