Quitar saltos de linea en un rango de celdas

[federtuc]

Hola, el problema que tengo es cuando intento Eliminar los saltos de línea en la misma macro, solo me selecciona el Rango de celdas pero no realiza la acción.
Esta es la macro:

Dim final
Private Sub CommandButton1_Click(): Dim n As Long
With ListBox1
For n = 0 To .ListCount - 1: maxCar .List, 10 ' <= corrige el 10 si quieres otro maximo de caracteres '
[b50].End(xlUp).Offset(1).Resize(UBound(final) + 1) = Application.Transpose(final)
Next: End With

' HASTA AQUI TODO PERFECTO


' AQUI ES DONDE SOLAMENTE SELECCIONA EL RANGO PERO NO ELIMINA LOS SALTOS DE LINEA, DEBERIA ELIMINARLOS

Hoja1.Range("B1:B50").Select

For Each celda In Selection
celda.Value = Replace(celda.Value, Chr(10), "")
Next
End Sub


Private Function maxCar(cadena As String, n As Long) As String: Dim cars, x As Long, mtz
With CreateObject("vbscript.regexp"): .Pattern = "(.{1," & n & "})"
.Global = True: .IgnoreCase = True: Set cars = .Execute(cadena)
For x = 0 To cars.Count - 1: mtz = mtz & vbLf & cars(x): Next
End With: final = Split(Mid(mtz, 2), vbLf): Set cars = Nothing
End Function

 

[Antoni]

Con el tiempo que llevas por aquí, ya deberías saber que sin el archivo va a ser difícil que alguien te conteste.

 

[federtuc]

Con el tiempo que levas por aquí, ya deberías saber que sin el archivo va a ser difícil que alguien te conteste.

Pequeño detalle
A la noche subo el archivo

 

[federtuc]

Subo el Archivo, paso a comentar como funciona.

Pinchamos en la Flecha Azúl

En el TextBox1 del formulario escribimos los datos, donde podemos saltar de linea con Ctrl + Enter, esto es posible debido a que la propiedad Multiline del TextBox1 está en True.
Una vez escritos el o los datos pinchamos en el Botón Añadir. Y estos se cargan en el ListBox1, si tiene 10 o mas caracteres el dato automaticamente pasa a la celda de abajo.
Ahora solamente queda pinchar en el Botón Guardar. Y los datos se guardan en la Hoja1.

Lo que quiero lograr y aún no he podido es quitar los saltos de linea que van quedando en algunas celdas de la columna B, puesto que al ser Multiline el TextBox1, me trae estos saltos a la Hoja.

 

[Antoni]

Sustituye TODO el código del formulario por esto:

Dim Fila As Long, x As Long, y As Long
'--
Private Sub CommandButton1_Click()
ListBox1.AddItem Replace(Replace(TextBox1, Chr(10), ""), Chr(13), "") '<----
End Sub
'--
Private Sub CommandButton2_Click(): Dim n As Long
With ListBox1
   Columns("B").ClearContents
   For x = 0 To .ListCount - 1
      For y = 1 To Len(.List(x)) Step 10
         Fila = Fila + 1
         Range("B" & Fila) = Mid(.List(x), y, 10)
      Next
   Next
End With
End Sub

 

[federtuc]

Sustituye TODO el código del formulario por esto:

Dim Fila As Long, x As Long, y As Long
'--
Private Sub CommandButton1_Click()
ListBox1.AddItem Replace(Replace(TextBox1, Chr(10), ""), Chr(13), "") '<----
End Sub
'--
Private Sub CommandButton2_Click(): Dim n As Long
With ListBox1
   Columns("B").ClearContents
   For x = 0 To .ListCount - 1
      For y = 1 To Len(.List(x)) Step 10
         Fila = Fila + 1
         Range("B" & Fila) = Mid(.List(x), y, 10)
      Next
   Next
End With
End Sub

Estuve revisando el código, cumple con lo que quiero lograr, pero no del todo.
Haber si me explico:
En el TextBox1 Multilinea escribo lo siguiente:

NARANJA DULCE
BANANA
MANZANA

Entonces añado al ListBox1 y quedando el ListBox1 así:
NARANJA DULCE¶BANANA¶MANZANA

Para ello

Private Sub CommandButton1_Click()
ListBox1.AddItem TextBox1
End Sub

Ahora viene lo interesante y lo que no he podido lograr hasta el momento

Al apretar Guardar deberia quedar así en la hoja desde la celda B2 hacia abajo

NARANJA DU <---- CELDA B2
LCE <---- CELDA B3
BANANA <---- CELDA B4
MANZANA <---- CELDA B5

Es decir, siempre que exista un ¶ (salto de linea) automaticamente pase a la celda de abajo, al igual que el máximo de caracteres por celda sea igual a 10 dígitos, mayor a eso tambien pase a la celda de abajo.




Finalmente si aplico para quitar los saltos de linea que pudieran quedar en algunas celdas:


Hoja1.Range("B1:B50").Select

For Each CELDA In Selection
CELDA.Value = Replace(Replace(CELDA, Chr(10), ""), Chr(13), "")
Next

 

[Héctor Miguel]

siempre que exista un ¶ (salto de linea) automaticamente pase a la celda de abajo

"esto" lo debes ajustar NO al pasar los datos a las celdas sino al pasarlos al listbox

al igual que el máximo de caracteres por celda sea igual a 10 dígitos, mayor a eso tambien pase a la celda de abajo

para esto, deja el codigo tal como te lo sugeri en tu consulta anterior

en resumen, cambia (todo) el codigo de tu formulario a lo siguiente:

Dim final
Private Sub CommandButton1_Click()
  Dim lineas, n As Long: lineas = Split(TextBox1, vbNewLine)
  For n = LBound(lineas) To UBound(lineas): ListBox1.AddItem lineas(n): Next
End Sub
Private Sub CommandButton2_Click(): Dim n As Long
  With ListBox1
    For n = 0 To .ListCount - 1: maxCar .List(n), 10 ' <= corrige el 10 si quieres otro maximo de caracteres '
      [b100].End(xlUp).Offset(1).Resize(UBound(final) + 1) = Application.Transpose(final)
    Next: End With
End Sub
Private Function maxCar(cadena As String, n As Long) As String: Dim cars, x As Long, mtz
  With CreateObject("vbscript.regexp"): .Pattern = "(.{1," & n & "})"
    .Global = True: .IgnoreCase = True: Set cars = .Execute(cadena)
    For x = 0 To cars.Count - 1: mtz = mtz & vbLf & cars(x): Next
  End With: final = Split(Mid(mtz, 2), vbLf): Set cars = Nothing
End Function