Jump to content
lphant

Unir 2 celdas en una con diferente color

Recommended Posts

Con esta macro en la hoja, cada vez que modifiques alguna celda del rango A:B, se realizará la acción requerida en la consulta.

Private Sub Worksheet_Change(ByVal Target As Range): 'On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Range("A:B"), Target) Is Nothing Then
   Range("C" & Target.Row) = Range("A" & Target.Row) & " " & Range("B" & Target.Row)
   Range("C" & Target.Row).Characters(1, Len(Range("A" & Target.Row))).Font.Color = vbBlue
   Range("C" & Target.Row).Characters(Len(Range("A" & Target.Row)) + 2, Len(Range("B" & Target.Row))).Font.Color = vbRed
End If
Application.EnableEvents = True
End Sub

 

Libro1 (4).xlsm

Share this post


Link to post
Share on other sites
Hace 32 minutos , Macro Antonio dijo:

Con esta macro en la hoja, cada vez que modifiques alguna celda del rango A:B, se realizará la acción requerida en la consulta.

Private Sub Worksheet_Change(ByVal Target As Range): 'On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Range("A:B"), Target) Is Nothing Then
   Range("C" & Target.Row) = Range("A" & Target.Row) & " " & Range("B" & Target.Row)
   Range("C" & Target.Row).Characters(1, Len(Range("A" & Target.Row))).Font.Color = vbBlue
   Range("C" & Target.Row).Characters(Len(Range("A" & Target.Row)) + 2, Len(Range("B" & Target.Row))).Font.Color = vbRed
End If
Application.EnableEvents = True
End Sub

 

Libro1 (4).xlsm

Muchas gracias Macro Antonio, funciona perfectamente.

Se podria poner con un boton en vez de automatico??.

un saludo,

Share this post


Link to post
Share on other sites
En ‎10‎/‎05‎/‎2017 at 15:49 , Mauricio_ODN dijo:

Haber mi Estimado dejo el archivo como pides, hechando mano del codigo de Maestro @Macro Antonio(Saludos Maestro).

Particularmente a mi me gustaba más le diseño inicial, Saludos!!

Libro1 (4).xlsm

gracias mauricio_odn, a mi tambien me gustaba el codigo de MAcro Antonio, la unica pega que los datos ya los tengo en la columna A y B.

muchas gracias a los 2.

ahora mismo lo pruebo.

un saludo,

Share this post


Link to post
Share on other sites
Private Sub JuntarConColores(): On Error Resume Next
Application.EnableEvents = False
If Range("A" & Rows.Count).End(xlUp).Row > _
   Range("B" & Rows.Count).End(xlUp).Row Then
   uf = Range("A" & Rows.Count).End(xlUp).Row
Else
   uf = Range("B" & Rows.Count).End(xlUp).Row
End If
For x = 1 To uf
   Range("C" & x) = Range("A" & x) & " " & Range("B" & x)
   Range("C" & x).Characters(1, Len(Range("A" & x))).Font.Color = vbBlue
   Range("C" & x).Characters(Len(Range("A" & x)) + 2, Len(Range("B" & x))).Font.Color = vbRed
Next
Application.EnableEvents = True
End Sub

 

Share this post


Link to post
Share on other sites
Hace 15 horas, Macro Antonio dijo:
Private Sub JuntarConColores(): On Error Resume Next
Application.EnableEvents = False
If Range("A" & Rows.Count).End(xlUp).Row > _
   Range("B" & Rows.Count).End(xlUp).Row Then
   uf = Range("A" & Rows.Count).End(xlUp).Row
Else
   uf = Range("B" & Rows.Count).End(xlUp).Row
End If
For x = 1 To uf
   Range("C" & x) = Range("A" & x) & " " & Range("B" & x)
   Range("C" & x).Characters(1, Len(Range("A" & x))).Font.Color = vbBlue
   Range("C" & x).Characters(Len(Range("A" & x)) + 2, Len(Range("B" & x))).Font.Color = vbRed
Next
Application.EnableEvents = True
End Sub

 

buenos dias;

Muchas gracias Macro Antonio, funciona perfectamente.

tema solucionado.

un saludo,

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png