(Индекс вне диапазона) Ошибка 9

ниже приведена модифицированная версия кода (я нашел на Stack Exchange), который я в настоящее время использую -

Option Explicit

Sub Main()

    Columns("E:E").NumberFormat = "@"
    Dim i As Long, c As Long, r As Range, v As Variant

    For i = 2 To Range("E" & Rows.Count).End(xlUp).Row
        v = Split(Range("E" & i), " ")
        c = c + UBound(v) + 1
    Next i

    For i = 2 To c
        Set r = Range("E" & i)
        Dim arr As Variant
        arr = Split(r, " ")
        Dim j As Long
        r = arr(0)
        For j = 1 To UBound(arr)
            Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
            r.Offset(j, 0) = arr(j)
r.Offset(j, -1) = r.Offset(0, -1)
r.Offset(j, -2) = r.Offset(0, -2)
r.Offset(j, -3) = r.Offset(0, -3)
r.Offset(j, 1) = r.Offset(0, 1)
r.Offset(j, 2) = r.Offset(0, 2)
r.Offset(j, 3) = r.Offset(0, 3)
r.Offset(j, 4) = r.Offset(0, 4)


        Next j
    Next i

End Sub

теперь проблема с этим кодом в том, что он дает мне ошибку (индекс вне диапазона) Ошибка 9.

чтобы объяснить, что я пытаюсь сделать: у меня есть несколько данных в отдельные ячейки, которые я хотел бы разделить на отдельные строки. Теперь этот код работает хорошо, но код не выполняется по всему листу и останавливается на нескольких записях.

посмотреть пример: пожалуйста, перейдите по ссылке, чтобы понять, что делает код. (https://stackoverflow.com/questions/19815321/text-to-rows-vba-excel) - К сожалению, у меня нет достаточно очков, чтобы добавить фотографии.

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

спасибо.

12
задан Community
31.03.2023 7:44 Количество просмотров материала 3557
Распечатать страницу

1 ответ

это только ломается для меня, когда диапазон пуст - так что я добавил if

Option Explicit

Sub Main()

    Columns("E:E").NumberFormat = "@"
    Dim i As Long, c As Long, r As Range, v As Variant

    For i = 2 To Range("E" & Rows.Count).End(xlUp).Row
        v = Split(Range("E" & i), " ")
        c = c + UBound(v) + 1
    Next i

    For i = 2 To c
        If Range("E" & i) <> "" Then
        Set r = Range("E" & i)
        Dim arr As Variant
        arr = Split(r, " ")
        Dim j As Long
        r = arr(0)
        For j = 1 To UBound(arr)
            Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
            r.Offset(j, 0) = arr(j)
            r.Offset(j, -1) = r.Offset(0, -1)
            r.Offset(j, -2) = r.Offset(0, -2)
            r.Offset(j, -3) = r.Offset(0, -3)
            r.Offset(j, 1) = r.Offset(0, 1)
            r.Offset(j, 2) = r.Offset(0, 2)
            r.Offset(j, 3) = r.Offset(0, 3)
            r.Offset(j, 4) = r.Offset(0, 4)
        Next j
        End If
    Next i

End Sub

Итак, ваши данные должны иметь двойные пробелы там, где они ломаются? Или что-то, где вы в конечном итоге с бланков в е. колонке


этот фрагмент кода можно использовать для удаления лишних пробелов в столбце E (my bad)

Sub test()
Dim c As Range
Dim lastrow As Integer
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
Dim strValue As String
For Each c In Range("E2:E" & lastrow)
    strValue = c.Value
    Do While InStr(1, strValue, "  ")
        strValue = Replace(strValue, "  ", " ")
    Loop
    c = strValue
Next
End Sub
0
отвечен Raystafarian 2023-04-01 15:32

Постоянная ссылка на данную страницу: [ Скопировать ссылку | Сгенерировать QR-код ]

Ваш ответ

Опубликуйте как Гость или авторизуйтесь

Имя
Вверх