Macro para combinar datos de filas

Estoy realizando una BBDD y al trabajar con los datos en una hoja excel me veo en la necesidad de realizar la siguiente operación.
Tengo cientos de filas con un texto que contiene dos puntos y otras líneas que no contienen los dos puntos.
Lo que necesito es que las líneas que no contienen los dos puntos: a) se combinen y b) si fuera posible, que se combinen también con la fila anterior, que sí tiene dos puntos.
Pongo un ejemplo para verlo claro -cada linea es una fila. Todo en la columna A-:
Tengo:
----------
Nombre: perico perez
Dirección:
C/ CAPULETO, 69-9ºB
Observaciones:
Se fue a comprar tabaco
Y no volvió
Necesito:
-------------
Nombre: perico perez
Dirección: c/ capuleto, 69-9ºb
Observaciones: se fue a comprar tabaco y no volvió
Gracias por anticipado. Un saludo,
Bricomatica

2 respuestas

Respuesta
1
Ingresa este código :
Sub Nueva_Forma()
    Dim Filas, Aux As Long
        Aux = 0
        For Filas = 1 To Range("A65535").End(xlUp).Row
            If InStr(Cells(Filas, 1), ":") = 0 Then
                Cells(Filas - 1, 2) = Cells(Filas - 1, 1) & " " & Cells(Filas, 1)
            Else
                Cells(Filas, 2) = Cells(Filas, 1)
                If Aux = 1 Then
                    Cells(Filas - 3, 2) = "OBSERVACIONES: " & Cells(Filas - 2, 2)
                    Cells(Filas - 2, 2) = ""
                    Aux = 0
                End If
                If InStr(Cells(Filas, 1), "OBSERVACIONES:") > 0 Then
                    Aux = 1
                End If
            End If
        Next Filas
        Cells(Filas - 3, 2) = "OBSERVACIONES: " & Cells(Filas - 2, 2)
        Cells(Filas - 2, 2) = ""
        For Filas = 1 To Range("B65535").End(xlUp).Row
            If Cells(Filas, 2) = "" Then
                Cells(Filas, 2).Delete Shift:=xlUp
            End If
        Next Filas
        For Filas = 1 To Range("B65535").End(xlUp).Row
            If Cells(Filas, 2) = "" Then
                Cells(Filas, 2).Delete Shift:=xlUp
            End If
        Next Filas
End Sub
Te cuento que tu formato debe estar en la columna A y el nuevo formato te lo dará en la columna B.
Espero que sea de tu ayuda. Cualquier consulta no dudes en preguntar.
Suerte.
Pitcher !
Hola Pitcher,
Muchisísmas gracias por tu macro. Funciona al 99% . Sólo falta lo siguiente:
El texto que se haya debajo de Nombre:, Dirección:, Observaciones: u otra fila puede tener más de dos líneas.
Por ejemplo:
Teléfono:
1234566
34634653456
636534563456
23452542345
Y necesito que eso se convierta en:
Teléfono: 1234566 34634653456 636534563456 23452542345
Es decir que permita varias filas. Si tienes que dar una cifra, pongamos 10 filas.
Gracias otra vez. Un saludo muy cordial,
Bricomatica
Ok. Creo que este código te servirá.
Sub Nueva_Forma1()
    Dim Filas, Aux, FilaAux, TexAux As Long
    Dim Texto As String
        Aux = 0
        TexAux = 0
        For Filas = 1 To Range("A65535").End(xlUp).Row
            If InStr(Cells(Filas, 1), ":") = 0 Then
                Texto = Texto & " " & Cells(Filas, 1)
                    If InStr(Cells(Filas + 1, 1), ":") > 0 Then
                        Aux = 1
                        TexAux = 0
                    Else
                        TexAux = 1
                    End If
            End If
            If Aux = 1 Then
                Cells(FilaAux, 2) = Cells(FilaAux, 2) & " " & Texto
                Texto = ""
                Aux = 0
            Else
                If TexAux = 0 Then
                    Cells(Filas, 2) = Cells(Filas, 1)
                    FilaAux = Filas
                End If
            End If
        Next Filas
        Cells(FilaAux, 2) = Cells(FilaAux, 2) & " " & Texto
        AuxCiclo = Range("B65535").End(xlUp).Row
        For Filas = 1 To AuxCiclo
            If Cells(Filas, 2) = "" Then
                Cells(Filas, 2).Delete Shift:=xlUp
                Filas = Filas - 1
                AuxCiclo = AuxCiclo - 1
                If Filas > AuxCiclo Then
                    Exit For
                End If
            End If
        Next Filas
End Sub


Espero que sea de tu ayuda. Cualquier consulta no dudes en preguntar.
Suerte
Pitcher !

A y no olvides cerrar la pregunta si la respuesta fue de tu ayuda.
Respuesta
1
Ok.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas