Poner en negrita palabras en texto concatenado en Excel

[@jhampierm]

Muchas gracias por compartir muy útil aporte

[@mamuelinimacperrin5797]

Excelente ayuda, muchas gracias

[@JorgeLandaverde-lr5ct]

Eres lo maximo, esto es oro, me resolviste un problema que tenia meses intentando resolver

[@ArisaiBolañosAlcauter]

Este codigo es muy útil, gracias por compartir. Una pregunta, es posible utilizar este codigo si el dato a poner en negrita está en una hoja diferente del mismo libro?

[@Jorge·M·Mostacero·A]

Saludos. Si. Solo cambia la línea donde va el Rango con las palabras que se pondrán en negrita, es decir Set B = Range("") por Set B = Worksheets("Nombre de la Hoja Diferente").Range("")

[@Jorge·M·Mostacero·A]

También esta esta otra alternativa kzbin.info/www/bejne/j5SXk2yjnb6reZYsi=UgmPsLt3-xvZI2I2

[@nedysurrego7801]

Mil gracias 🫂

[@rafaelbenavente209]

muy buen aporte mil gracias!!, me puedes decir si hay posibilidad de concatenar con formato el texto de una celda que tiene espacios, ya que con esta formula no me le aplica el formato a las celdas que tienen caracteres con espacios. de antemano mil gracias

[@Jorge·M·Mostacero·A]

Saludos, gracias por la observación y el comentario que permitirá mejorar el aporte. Mientras tanto te comparto esta opción la cual no es dinamica pero si te servirá hasta que pueda mejorar el detalle que indicas kzbin.info/www/bejne/j5SXk2yjnb6reZYsi=L3xVUaUOuiddlPF1

[@Jorge·M·Mostacero·A]

Saludos, ya corregí el código para que ponga en negrita el contenido con mas de una palabra. Cualquier inconveniente lo haces saber para seguir mejorando este aporte.

[@0oPPo0]

Hola, disculpa, cómo puedo poner el código si lo quiero usar dos veces en la misma hoja? Intenté copiar y pegar en el mismo módulo cambiando los rangos pero investigando me di cuenta que no se puede usar "Private Sub Worksheet_Change (ByVal Target As Range)" dos veces en el mismo código, qué procede? Espero su respuesta, de antemano gracias

[@Jorge·M·Mostacero·A]

Saludos, no había previsto un panorama como el que indicas. Para mas de una aplicación puede servir esto kzbin.info/www/bejne/j5SXk2yjnb6reZY

[@JAVIERSILVAV]

alguien sabe como poner negrita a una sola palabra, en una celda que contenga varias palabras en Excel para móviles?

[@Jorge·M·Mostacero·A]

Saludos Excel en móvil es limitado, tendrías que seleccionar manualmente el texto y aplicar el formato negrita.

[@JAVIERSILVAV]

@@Jorge·M·Mostacero·A Pero precisamente eso es lo que no se puede hacer, yo selecciono una palabra que necesito poner negrilla en la celda y en Excel para móviles no lo permite, lo unico que deja hacer es poner negrilla a toda la celda.

[@rodriigoarturofuentes8319]

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("E3:E5")) Is Nothing Then Dim o As Range, R As Range, B As Range, C As Range Dim palabra As Variant Dim celdaActiva As Range Set o = Range("E18:E22") ' Rango con los datos concatenados Set R = Range("A18:A22") ' Rango resultado Set B = Range("E2:E5") ' Rango con las palabras que se pondrán en negrita Set celdaActiva = ActiveCell Application.EnableEvents = False R.Value = o.Value For Each C In R C.Font.Bold = False For Each palabra In Split(C.Text) ' Separar la concatenación en palabras For Each bCell In B If palabra = bCell.Value Then posInicial = 1 Do While posInicial > 0 ' Continuar buscando la palabra en la celda posInicial = InStr(posInicial, C.Text, palabra) If posInicial > 0 Then longitud = Len(palabra) C.Characters(posInicial, longitud).Font.Bold = True posInicial = posInicial + longitud ' Mover la posición de inicio después de la última ocurrencia End If Loop End If Next bCell Next palabra Next C Application.EnableEvents = True If Not celdaActiva Is Nothing Then celdaActiva.Select End If End Sub

[@rodriigoarturofuentes8319]

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, ) Is Nothing Then Dim o As Range, R As Range, B As Range, C As Range Dim celdaActiva As Range Set o = Range("") Set R = Range("") Set B = Range("") Set celdaActiva = ActiveCell Application.EnableEvents = False R.Value = o.Value For Each C In R C.Font.Bold = False For Each bCell In B If InStr(1, C.Text, bCell.Value) > 0 Then posInicial = InStr(1, C.Text, bCell.Value) longitud = Len(bCell.Value) C.Characters(posInicial, longitud).Font.Bold = True End If Next bCell Next C Application.EnableEvents = True If Not celdaActiva Is Nothing Then celdaActiva.Select End If End Sub