Jump to content
miguel.sme

Concatenar celdas manteniendo dos colores

Recommended Posts

Buenas tardes,

tengo esta macro que lee caracter a caracter y los concatena con su mismo formato, en este caso concatena manteniendo color de ambas celdas.

La he probado y es muy lenta cuando hay muchas lineas con muchos carcateres en cada celda.

Como en realidad sólo tengo texto en dos colores que se encuentran siempre en celdas separadas, no sé si se podría optimizar y hacerla más rápida y ligera.

Os copio el código y adjunto ejemplo:

Sub COPYPASTECOLORINDEX()
Set myRange = Range("A:B") 'aquí le digo el rango del aprimera columna
For Each c In myRange.Cells
    If c.Value <> "" Then
        If c.Offset(0, 1).Value = "" Then
            c.Offset(0, 2).Value = c.Value
        Else
            c.Offset(0, 2).Value = c.Value & Chr(10) & c.Offset(0, 1).Value
            'c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.ColorIndex = c.Offset(0, 1).Characters(Len(CStr(c.Value))).Font.ColorIndex
        End If
    End If
   
       For i = 1 To Len(CStr(c.Value))
   c.Offset(0, 2).Characters(i, 1).Font.ColorIndex = c.Characters(i, 1).Font.ColorIndex
   Next i
          For j = 1 To Len(CStr(c.Offset(0, 1).Value))
   c.Offset(0, 2).Characters(i + j, 1).Font.ColorIndex = c.Offset(0, 1).Characters(j, 1).Font.ColorIndex
   Next j
Next c
End Sub

 

 

colores.xlsx.xlsm

Share this post


Link to post
Share on other sites

Como sólo son dos colores, y además un color en cada celda,  he cambiado a esta macro:

 

Sub concatenarycolor1()

Dim uA, i&

uA = Range("A" & Rows.Count).End(xlUp).Row

For i = uA To 1 Step -1
    
    If Cells(i, "A") <> 0 Or Cells(i, "A") <> "#n/d" Then
   
        Value1 = ActiveCell.Value
        Color1 = ActiveCell.Font.Color
        Len1 = Len(Value1)

    ActiveCell.Offset(0, 1).Range("A1").Select
        Value2 = ActiveCell.Value
        Color2 = ActiveCell.Font.Color
        Len2 = Len(Value2)

    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.Value = Value1 & Chr(10) & Value2

        With ActiveCell.Characters(Start:=1, Length:=Len1).Font
         .Color = Color1
        End With
        
        With ActiveCell.Characters(Start:=Len1 + 2, Length:=Len2).Font
         .Color = Color2
        End With


      ActiveCell.Offset(1, -2).Range("A1").Select


    End If


Next i

End Sub

 

Pero encuentro un problema,  no quiero unir las dos celdas que contengan un 0 o "#n/d" o un espacio en blanco. En ese caso sólo debería elegir el valor de la otra celda que tiene contenido disitinto a éstos. La que no tiene ese valor. Actualmente está uniendo ambas celdas en todos los casos.

Adjunto ejemplo.

 

concatenarycolor.XLSB

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



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png