Сплит строки в Excel (VBA)

Question

В настоящее время я использую этот код (от другого пользователя), чтобы найти каждую ячейку в столбце b1 и найти те, которые содержат «;» что-то вроде "привет; до свидания". Код разделит ячейку на ";" и поместите "до свидания" прямо под "привет"; в совершенно новом ряду ..

Теперь мне нужно следующее ... если ячейка содержит , кратную ";" (то есть "привет; до свидания; йо; привет; эй") это разделится в КАЖДОМЕ ";" а не только первый, а затем переместите каждый в новый ряд непосредственно под другим ...

Какие изменения мне нужно сделать?

Dim r1 As Range, r2 As Range
Dim saItem() As String


For Each r1 In ActiveSheet.Range("B1", Cells(Application.Rows.Count, 2).End(xlUp))
If InStr(1, r1.Value2, ";") > 0 Then
saItem = Split(r1.Value2, ";")
r1 = Trim$(saItem(0)) & ";"
r1.Offset(1).EntireRow.Insert (xlDown)
r1.Offset(1) = Trim$(saItem(1))
End If
Next r1

Answer 1

Я знаю, что это близко к тому, что у вас есть, но я хотел предложить вам использовать Application.ScreenUpdating.Это сэкономит значительное время, особенно при вставке / удалении строк в Excel.Я также хотел предложить вам изменить имена переменных на что-то более значимое.

Sub SplitCells()

Application.ScreenUpdating = False
Dim strings() As String
Dim i As Long

For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
    If InStr(Cells(i, 2).Value, ";") <> 0 Then
        strings = Split(Cells(i, 2).Value, ";")
        Rows(i + 1 & ":" & i + UBound(strings)).Insert
        Cells(i, 2).Resize(UBound(strings) + 1).Value = _
        WorksheetFunction.Transpose(strings)
    End If
Next

Application.ScreenUpdating = True

End Sub

PS Меньшие изменения - использовать "2" вместо "B".Если вы используете ячейки () вместо Range (), то можете пройти весь путь до конца:)

Answer 2

Я нашел ответ на

http://www.excelforum.com/excel-programming/802602-vba-macro-to-split-cells-at-every.html

Это решение, которое мне дали:

Sub tgr()

Dim rindex As Long
Dim saItem() As String

For rindex = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
    If InStr(Cells(rindex, "B").Value, ";") > 0 Then
        saItem = Split(Cells(rindex, "B").Value, ";")
        Rows(rindex + 1 & ":" & rindex + UBound(saItem)).Insert
        Cells(rindex, "B").Resize(UBound(saItem) + 1).Value =     WorksheetFunction.Transpose(saItem)
    End If
Next rindex

End Sub