Saltar al contenido

Macro para añadir info a celdas


Recommended Posts

Prueba.xlsx

Saludos y muchas gracias a todos de antemano. Adjunte una tabla que aunque no les parezca lógica es muy parecida a lo que quiero hacer. No puedo subir la original por mi trabajo, pero la primera columna es exactamente lo que tengo, me explico. Verán en la tabla adjunta una serie de información tal como: 9010-00 sin ninguna información  en la columna de información. Me interesa añadir de manera automática lo siguiente: Por ejemplo

9010-00  -- la información del 9010-01, la información del 9010-02, ......

9010-01  --- información del 9010-01

9010-02  -- información del 9010-02

Luego viene otra nueva

9012-00  -- la información del 9012-01, la información del 9012-02

y así sucesivamente..donde la información de cada uno sea separada por una coma y un espacio.

El problema es que tengo alrededor de 350 lineas con ####-00 donde se tiene que llenar de manera automatica siempre y cuando los primeros 4 números sean iguales..

Espero poder haberme explicado..

Enlace a comentario
Compartir con otras webs

Hola.

Si he entendido bien el problema, podrías utilizar el siguiente código:

 

Private Sub Compl00()
Dim lF As Long
Dim lP As Long
Dim sD As String

    With Cells(1, 1).CurrentRegion
        For lF = 2 To .Rows.Count
            If .Cells(lF, 1) Like "*-00" Then
                If sD <> "" Then
                    .Cells(lP, 2) = Left(sD, Len(sD) - 2)
                    sD = ""
                End If
                lP = lF
            Else
                If .Cells(lP, 2) = "" Then
                    'Si se tienen en cuenta las celdas en blanco:
                    sD = sD & .Cells(lF, 2) & ", "
                    'Si se quieren evitar, eliminar la anterior y quitar el comentario a esta:
                    'If Trim(.Cells(lF, 2)) <> "" Then sD = sD & .Cells(lF, 2) & ", "
                End If
            End If
        Next
        If .Cells(lP, 2) = "" Then .Cells(lP, 2) = Left(sD, Len(sD) - 2)
    End With

End Sub

Un saludo.

Prueba.xlsm

Enlace a comentario
Compartir con otras webs

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.