¿Es posible dividir celdas con saltos de línea en múltiples filas en un rango? - excel, vba, excel-vba, line-breaks

Tengo un rango de datos, donde algunas de las celdastengo saltos de línea, y necesito dividir los saltos de línea en filas debajo de donde ocurre el salto de línea, pero dejar las otras celdas como están. También hay varias columnas si eso hace una diferencia.

He usado las dos respuestas que se brindan a continuación, con algunos ajustes para ajustarme a mi hoja de trabajo, pero ninguna de ellas funciona para dividir TODAS las celdas. Terminé incluso probando ambos, pero eso tampoco funciona.

Cuando hay un salto de línea en la columna A, estrabajando, pero cuando no hay un salto de línea en la columna A, y hay otra columna, no funciona. Si NO hay un salto de línea en la columna A, solo necesito dividir la fila donde hay un salto de línea y fusionarla en la fila de abajo.

Aquí están los códigos:

end_row = range("A" & Rows.count).End(xlUp).row

range("A:A").TextToColumns Destination:=range("a1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
:="   ", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

For i = 1 To end_row
row_added = False
For j = 1 To 4
If InStr(1, Cell, Chr(10)) <> 0 Then
If Not row_added Then
Rows(i + 1).Insert
row_added = True
end_row = end_row + 1
End If
Cells(i + 1, j) = Right(Cells(i, j), Len(Cells(i, j)) - InStr(1, Cell, Chr(10)))
Cells(i, j) = Left(Cells(i, j), InStr(1, Cell, Chr(10)) - 1)
End If
Next j
Next i

Y

Sub LFtoRow()
Dim myWS As Worksheet, myRng As range
Dim LastRow As Long, iLoop As Long, jLoop As Long
Dim myString() As String

Set myWS = ActiveSheet
LastRow = myWS.Cells(myWS.Rows.count, 1).End(xlUp).row

For iLoop = LastRow To 1 Step -1
myString = Split(myWS.Cells(iLoop, 1), Chr(10))
If UBound(myString, 1) > 0 Then
myWS.Rows(iLoop + 1 & ":" & iLoop + UBound(myString, 1)).Insert shift:=xlShiftDown
For jLoop = 0 To UBound(myString, 1)
myWS.Cells(iLoop + jLoop, 1) = myString(jLoop)
Next jLoop
End If
Next iLoop

End Sub

Ya sea un nuevo código completo, o simplemente algo paraAñadir al final funcionaría. Tengo un ejemplo de lo que está sucediendo y cómo me gustaría que se vea a continuación. (Sé que muestra la columna B en la foto, pero en este punto de la MACRO está en la columna A)

Que esta pasando:

Lo que necesito para pasar:

Respuestas

1 para la respuesta № 1

Recomendaría un código similar al siguiente para resolver su problema. Tiene las siguientes propiedades:

1. Utiliza la función Dividir en Chr (10) para determinar las cadenas que necesitas en cada línea. Chr (10) es el carácter de salto de línea. Split genera una matriz de cadenas para ti.
2. Inserta el número correcto de filas para ti.
3. Recorre su rango desde abajo hacia arriba, de modo que procesa el rango completo.

El código ...

Sub LFtoRow()
Dim myWS As Worksheet, myRng As Range
Dim LastRow As Long, iLoop As Long, jLoop As Long
Dim myString() As String

Set myWS = Worksheets("Sheet1")
LastRow = myWS.Cells(myWS.Rows.Count, 1).End(xlUp).Row

For iLoop = LastRow To 1 Step -1
myString = Split(myWS.Cells(iLoop, 1), Chr(10))
If UBound(myString, 1) > 0 Then
myWS.Rows(iLoop + 1 & ":" & iLoop + UBound(myString, 1)).Insert Shift:=xlShiftDown
For jLoop = 0 To UBound(myString, 1)
myWS.Cells(iLoop + jLoop, 1) = myString(jLoop)
Next jLoop
End If
Next iLoop

End Sub

Cuando se presenta con esta entrada ...

... genera este resultado ...

---

0 para la respuesta № 2

Aquí está mi sugerencia de que debería manejar los saltos de línea en todas las columnas.

También quité el reemplazo que inserta un ";" y luego se divide en eso. El código completo será:

end_row = Range("A" & Rows.Count).End(xlUp).Row

Range("A:A").TextToColumns Destination:=Range("a1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
:="   ", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

For i = 1 To end_row
row_added = False
For j = 1 To 4
If InStr(1, Cell, Chr(10)) <> 0 Then
If Not row_added Then
Rows(i + 1).Insert
row_added = True
end_row = end_row + 1
End If
Cells(i + 1, j) = Right(Cells(i, j), Len(Cells(i, j)) - InStr(1, Cell, Chr(10)))
Cells(i, j) = Left(Cells(i, j), InStr(1, Cell, Chr(10)) - 1)
End If
Next j
Next i

---

0 para la respuesta № 3

Lo más probable es que esta no sea la forma más concisa de hacer esto, pero terminó trabajando para mí usando el código de @OldUgly ".

Sub LFtoRow()
Dim myWS As Worksheet, myRng As range
Dim LastRow As Long, iLoop As Long, jLoop As Long
Dim myString() As String

Set myWS = ActiveSheet
LastRow = myWS.Cells(myWS.Rows.count, 1).End(xlUp).row

For iLoop = LastRow To 1 Step -1
myString = Split(myWS.Cells(iLoop, 1), Chr(10))
If UBound(myString, 1) > 0 Then
myWS.Rows(iLoop + 1 & ":" & iLoop + UBound(myString, 1)).Insert shift:=xlShiftDown
For jLoop = 0 To UBound(myString, 1)
myWS.Cells(iLoop + jLoop, 1) = myString(jLoop)
Next jLoop
End If
Next iLoop

For iLoop = LastRow To 1 Step -1
myString = Split(myWS.Cells(iLoop, 2), Chr(10))
If UBound(myString, 1) > 0 Then
For jLoop = 0 To UBound(myString, 1)
myWS.Cells(iLoop + jLoop, 2) = myString(jLoop)
Next jLoop
End If
Next iLoop

For iLoop = LastRow To 1 Step -1
myString = Split(myWS.Cells(iLoop, 3), Chr(10))
If UBound(myString, 1) > 0 Then
For jLoop = 0 To UBound(myString, 1)
myWS.Cells(iLoop + jLoop, 3) = myString(jLoop)
Next jLoop
End If
Next iLoop

For iLoop = LastRow To 1 Step -1
myString = Split(myWS.Cells(iLoop, 4), Chr(10))
If UBound(myString, 1) > 0 Then
For jLoop = 0 To UBound(myString, 1)
myWS.Cells(iLoop + jLoop, 4) = myString(jLoop)
Next jLoop
End If
Next iLoop

For iLoop = LastRow To 1 Step -1
myString = Split(myWS.Cells(iLoop, 5), Chr(10))
If UBound(myString, 1) > 0 Then
For jLoop = 0 To UBound(myString, 1)
myWS.Cells(iLoop + jLoop, 5) = myString(jLoop)
Next jLoop
End If
Next iLoop

End Sub

---