Ordenar datos (Direcciones) en forma horizontal

Es mi primera pregunta y espero hacerla correctamente, estoy atorado
Tengo un archivo en Excel con muchas direcciones de contactos pero está en forma vertical en la primera columna y separados por espacios cada una de las direcciones, la cantidad de renglones vacíos que los separa no es la misma en todos los datos, ni tampoco los renglones de los datos de cada contacto

1 Respuesta

Respuesta
1
No sé si he entendido correctamente lo que quieres. Espero que sí.
Te he preparado una macro para que la grabes y ejecutes. Es la siguiente:
'------------------------------------------------------------------------------------------------
Option Explicit
Sub separaDireccionesEnOtraHoja()
    Const nomHojaDatos = "Hoja1"    ' Hay que poner dónde están los datos
    Const nomHojaSalida = "Hoja2"   ' Nombre de la hoja donde dejaremos la lista final
    Dim shOri As Worksheet
    Dim shDes As Worksheet
    Dim nLinOri As Long
    Dim nLinDes As Long
    Dim maxLinOri As Long   ' último número de línea usado en la hoja de datos
    Dim aux As String
    Dim n As Integer ' Para localizar espacios en el texto leido
    Dim txtSalida As String ' Texto a escribir en la hoja de salida (una direccion sóla)
    ' Asignamos cada hoja a una variable para trabajar mejor con la hoja
    Set shOri = Sheets(nomHojaDatos)
    Set shDes = Sheets(nomHojaSalida)
    ' Inicializamos los datos de la hoja de salida
    shDes.Cells.Delete  ' Borramos el contenido de la hoja de salida
    nLinDes = 0 ' De momento no hemos escrito ninguna línea en la salida
    ' Obtenemos el último número de fila usado en la página de datos (origen)
    maxLinOri = shOri.Cells.SpecialCells(xlCellTypeLastCell).Row
    ' Repetimos para todas las filas de la hoja de datos...
    For nLinOri = 1 To maxLinOri
        ' Leemos el contenido de la celda en la columna 1 (la A)
        aux = Trim$(shOri.Cells(nLinOri, 1)) ' Con trim$ quitamos los blancos del inicio y final
        ' Si tiene algún contenido... lo mandaremos a la salida (separando datos si vienen espacios)
        Do While aux <> ""
            n = InStr(aux, " ")
            If n = 0 Then
                ' No hay blancos. Escribiremos lo que tengamos
                txtSalida = aux
                aux = ""
              Else
                ' Escribimos hasta antes del blanco y lo quitamos de la variable
                txtSalida = Left$(aux, n - 1)
                aux = Trim$(Right$(aux, Len(aux) - n))
            End If
            ' Escribimos el texto en la hoja de salida
            nLinDes = nLinDes + 1
            shDes.Cells(nLinDes, 1) = txtSalida
        Loop
    Next nLinOri
    MsgBox "Proceso terminado"
End Sub
'------------------------------------------------------------------------------------------------
Para grabarla tienes que entrar en el editor de Visual Basic (<Alt><F11>), crear un módulo nuevo (menú Insertar - opción Módulo), y copiar/pegar el código que te he puesto.
Por cierto, si las páginas de tu hoja de cálculo no se llaman "Hoja1" y "Hoja2", tendrás que cambiar esos nombres al principio del código que te he puesto.
Otra cosa: el contenido de la ¿Hoja2? (La de salida) se borra completamente, por lo que si tienes algún dato en ella se perderá (haz copia si quieres conservarlo).
Desde la hoja de cálculo ejecutas el código con <Alt><F8> o bien entrando a través del menú Herramientas - Macro - Macros.
Espero que sea eso lo que quieres, sino... dame más detalles.
La información la tengo de la siguiente manera:
             Columna A
Renglon '01 AGNICO EAGLE MEXICO, S.A. DE C.V.
Renglon '02 Ing. Luis Felipe Medina Aguirre
Renglon '03 Paseo Bolivar No. 206, Col. Centro.
Renglon '04 C.P. 31000, Chihuahua, Chihuahua.
Renglon '05 Tel. (614) 180-31-00 Tel. Proyecto (635) 457-3136 y 457-6001
Renglon '06 Fax: (614) 430-1479 
Renglon '07 RFC: AEM-050110-CF8
Renglon '08 e-mail: (xxxxxx) 
Renglon '09    Vacio
Renglon '10     Vacio
Renglon '11     Vacio
Renglon '12 ALS CHEMEX DE MEXICO, S.A. DE C.V.
Renglon '13 Ing. Steve Armstrong
Renglon '14 Blvd. Ignacio Salazar No. 688-5, Col. Los Viñedos
Renglon '15 83127 Hermosillo, Sonora
Renglon '16 Tel: (662) 218-4403 Fax: (662) 218-4487
Renglon '17 RFC: ACM-920206-U5A
Renglon '18 e-mail: (xxxxxx)
Renglon '19    Vacio
Renglon '20     Vacio
Renglon '21 ARAUJO MONCADA JUAN JOSÉ (ING.)
Renglon '22 Prol. Calzada de Guadalupe No. 3350, Col. Satélite.
Renglon '23 C.P. 78380, San Luis Potosi, SLP
Renglon '24 Tel: (444) 820-3359
Renglon '25 e-mail: (xxxxxx)
  La información de los renglones la quiero en las columnas a partir de la "A", y cuando encuentre renglones vacíos vuelva a empezar a poner los datos abajo del dato anterior que puso a partir de la columna "A".
Entonces creo que es esto lo que quieres:
Option Explicit
Sub separaDireccionesEnOtraHoja()
    Const nomHojaDatos = "Hoja1"    ' Hay que poner dónde están los datos
    Const nomHojaSalida = "Hoja2"   ' Nombre de la hoja donde dejaremos la lista final
    Dim shOri As Worksheet
    Dim shDes As Worksheet
    Dim nLinOri As Long
    Dim nColDes As Long
    Dim nLinDes As Long
    Dim maxLinOri As Long   ' último número de línea usado en la hoja de datos
    Dim aux As String
    Dim n As Integer ' Para localizar espacios en el texto leido
    Dim txtSalida As String ' Texto a escribir en la hoja de salida (una direccion sóla)
    ' Asignamos cada hoja a una variable para trabajar mejor con la hoja
    Set shOri = Sheets(nomHojaDatos)
    Set shDes = Sheets(nomHojaSalida)
    ' Inicializamos los datos de la hoja de salida
    shDes.Cells.Delete  ' Borramos el contenido de la hoja de salida
    nLinDes = 1 ' Empezaremos a escribir en la fila 1
    ' Obtenemos el último número de fila usado en la página de datos (origen)
    maxLinOri = shOri.Cells.SpecialCells(xlCellTypeLastCell).Row
    ' Saltamos hasta la primera línea con datos
    nLinOri = 1
    Do While Trim$(shOri.Cells(nLinOri + 1, 1)) = ""
        nLinOri = nLinOri + 1
    Loop
    ' Ahora tendrían que venir los datos
    Do While nLinOri <= maxLinOri
        ' Leemos el contenido de la celda en la columna 1 (la A)
        aux = Trim$(shOri.Cells(nLinOri, 1)) ' Con trim$ quitamos los blancos del inicio y final
        ' Si la celda está vacía, nos tenemos que mover hasta la última vacía
        ' que tenga una con datos a continuación, al tiempo que incrementamos en 1 la
        ' columna y ponemos a 0 el número de fila
        If aux = "" Then
            Do  ' Para saltar todas las líneas en blanco (si hay más de una)
                If Trim$(shOri.Cells(nLinOri + 1, 1)) <> "" Then Exit Do
                nLinOri = nLinOri + 1
            Loop Until nLinOri > maxLinOri
            nLinDes = nLinDes + 1
            nColDes = 0
          Else
            ' Escribimos en la siguiente columna el dato
            nColDes = nColDes + 1
            shDes.Cells(nLinDes, nColDes) = aux
        End If
        nLinOri = nLinOri + 1
    Loop
    MsgBox "Proceso terminado"
End Sub
Si quieres que en lugar de por filas lo ponga por columnas, sólo tendrías que cambiar todas las filas donde pone 'nLinDes' poner 'nColDes' y viceversa, excepto la línea que pone "shDes.Cells(nLinDes, nColDes) = aux".
S.M.F.
Muchas gracias,
La macros arroja la información que requiero para terminar mi listado y poder ponerlos en la mi libro de contactos
Me despido con un afectuoso saludo y que pases un excelente fin de año.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas