Jump to content
DARIEN HERNANDEZ

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..

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.




×
×
  • Create New...

Important Information

Privacy Policy