(Subscrito fora do intervalo) Erro 9

Question

Abaixo está uma versão modificada de um código (encontrado no Stack Exchange) que estou usando no momento -

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

Agora o problema com este código é que ele me dá um erro (Subscrito fora do intervalo) Erro 9.

Para explicar o que estou tentando fazer: tenho vários dados em células individuais que gostaria de dividir em linhas separadas. Agora, esse código funciona bem, mas o código não é executado em toda a planilha e pára em algumas entradas.

Para ver um exemplo: siga o link para entender o que o código faz. ( link ) - Desculpe, não tenho pontos suficientes para adicionar imagens.

Por favor, entenda que eu sou muito novo nisso e não sei o que estou fazendo na maior parte do tempo.

Obrigado.

    

Answer 1

Ele só quebra para mim quando o intervalo está em branco - por isso adicionei um 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

Então, seus dados devem ter alguns espaços duplos onde eles quebram? Ou algo em que você acaba com espaços em branco na coluna E.

Você pode usar este snippet para remover seus espaços extras na coluna E (meu problema)

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