Excel - Negrita solo a parte de celda

Pos: 19

Val: 140

Negrita solo a parte de celda

Publicado por Luis (60 intervenciones) el 16/11/2020 19:39:01

Buenas!!

Antes de nada, muchas gracias a todos.

He estado mirando por todos los sitios, pero ninguna macro, adaptándola hasta mis conocimientos, me ha servido.

Adjunto EXCEL:

Necesito una macro que haga que en la columna A se ponga en negrita sólo lo de después del último guion (NE1) y en la columna B, lo mismo (lo de antes del primer guion).

Gracias de nuevo ;)

Muestra.zip(6,7 KB)

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 2

Val: 4.908

Negrita solo a parte de celda

Publicado por Antoni Masana (2479 intervenciones) el 16/11/2020 21:32:59

Si utilizas el GRABAR MACRO y realizas la acción veras como se hace.

El resultado es este:

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

Sub Macro1()

' Macro1 Macro

    Range("A2:A3").Select

    ActiveCell.FormulaR1C1 = "200-2-621895_200-2-679520_191213-NE1"

    With ActiveCell.Characters(Start:=1, Length:=33).Font

        .Name = "Arial"

        .FontStyle = "Normal"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    With ActiveCell.Characters(Start:=34, Length:=3).Font

        .Name = "Arial"

        .FontStyle = "Negrita"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    Range("B2:B3").Select

    ActiveCell.FormulaR1C1 = "NE1-200-2-621895_200-2-679520_191213"

    With ActiveCell.Characters(Start:=1, Length:=4).Font

        .Name = "Arial"

        .FontStyle = "Normal"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    With ActiveCell.Characters(Start:=5, Length:=3).Font

        .Name = "Arial"

        .FontStyle = "Negrita"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    With ActiveCell.Characters(Start:=8, Length:=29).Font

        .Name = "Arial"

        .FontStyle = "Normal"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    Range("A5:A6").Select

    ActiveCell.FormulaR1C1 = "200-2-682651_200-2-685632_191213-NE2"

    With ActiveCell.Characters(Start:=1, Length:=6).Font

        .Name = "Arial"

        .FontStyle = "Normal"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    With ActiveCell.Characters(Start:=7, Length:=6).Font

        .Name = "Arial"

        .FontStyle = "Negrita"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    With ActiveCell.Characters(Start:=13, Length:=24).Font

        .Name = "Arial"

        .FontStyle = "Normal"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    Range("B5:B6").Select

    ActiveCell.FormulaR1C1 = "NE2-200-2-682651_200-2-685632_191213"

    With ActiveCell.Characters(Start:=1, Length:=30).Font

        .Name = "Arial"

        .FontStyle = "Normal"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    With ActiveCell.Characters(Start:=31, Length:=6).Font

        .Name = "Arial"

        .FontStyle = "Negrita"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

End Sub

Como puedes ver el resultado de grabar macro es muy largo y realmente lo que necesitas es esto:

Sub Macro2()

    Range("A2:A3").Select

    ActiveCell.FormulaR1C1 = "200-2-621895_200-2-679520_191213-NE1"

    With ActiveCell.Characters(Start:=34, Length:=3).Font

        .FontStyle = "Negrita"

    End With

    Range("B2:B3").Select

    ActiveCell.FormulaR1C1 = "NE1-200-2-621895_200-2-679520_191213"

    With ActiveCell.Characters(Start:=5, Length:=3).Font

        .FontStyle = "Negrita"

    End With

    Range("A5:A6").Select

    ActiveCell.FormulaR1C1 = "200-2-682651_200-2-685632_191213-NE2"

    With ActiveCell.Characters(Start:=7, Length:=6).Font

        .FontStyle = "Negrita"

    End With

    Range("B5:B6").Select

    ActiveCell.FormulaR1C1 = "NE2-200-2-682651_200-2-685632_191213"

    With ActiveCell.Characters(Start:=31, Length:=6).Font

        .FontStyle = "Negrita"

    End With

End Sub

Te adjunto el libro con las dos macros para que las pruebes y con el texto antes y después.
Si necesitas más ayuda dimelo.

Saludos.
\\//_

Muestra_Macro.zip(14,5 KB)

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

Pos: 19

Val: 140

Negrita solo a parte de celda

Publicado por Luis (60 intervenciones) el 16/11/2020 21:47:04

Muchas gracias!

El problema es que son muchísimas celdas con las misma estructura de texto pero textos diferentes...

Gracias.

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Negrita solo a parte de celda

Publicado por Antoni Masana (2479 intervenciones) el 16/11/2020 22:47:17

Sabiendo que criterio utilizas para poner negrita es cuestión de que la macro lea el contenido de la celda, busque la posición y la longitud del texto y ponga la negrita.
En la macro se cambia los números por variables y listo.

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Negrita solo a parte de celda

Publicado por Luis (60 intervenciones) el 16/11/2020 23:08:11

Si pero si son 1000 celdas, tendría que copiar los 1000 textos no? Y eso es cambiante, no son siempre el mismo número.

Deberia detectar el guion o algo por el estilo, haya lo que haya en la celda.

Gracias!

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Negrita solo a parte de celda

Publicado por Antoni Masana (2479 intervenciones) el 16/11/2020 23:20:58

Sube un libro con unos ejemplos de cada caso y explícame la regla de poner negrita con unos ejemplo.

Necesito una macro que haga que en la columna A se ponga en negrita sólo lo de después del último guion (NE1) y en la columna B, lo mismo (lo de antes del primer guion).

200-2-621895_200-2-679520_191213-NE1

200-2-682651_200-2-685632_191213-NE2

NE1-200-2-621895_200-2-679520_191213

NE2-200-2-682651_200-2-685632_191213

¿En que caso es el primer o el ultimo guion?
¿Los que están en determinada columna?
¿Los que empiezan por ...?
¿Los que terminan por ...?
Los que contienes ... en la posición ...?

Algo así me ayuda mucho.

Mañana sigo que me voy a dormir.

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Negrita solo a parte de celda

Publicado por Luis (60 intervenciones) el 17/11/2020 00:15:19

Jaja descansa.

Gracias por la dedicacion.

El libro seria el mismo (no puedo acceder al ordenador ahora) pero con muchas celdas. En la columna A, despues del ultimo guion (posicion 35) hasta el final y en la B desde el principio hasta el primer guion.

El problema de la columna B es que el numero de caracteres varia de celda en celda.

Y lo que debe estar en negrita puede variar tambien en numero de caracteres y no ser siempre 3 (NE1, NE2, NE3...NE56...).

Gracias;)

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Negrita solo a parte de celda

Publicado por Antoni Masana (2479 intervenciones) el 17/11/2020 14:03:31

Te pongo una macro como posible solución porque tengo pocas muestras para probarla.

Sub Poner_Negrita()

    Dim Fila As Long, Ps As Byte

    For Fila = 1 To 1000

        ' ---&--- Columna A

        Range("A" & Fila).Select

        If Len(ActiveCell.Text) > 0 Then

            With ActiveCell.Characters(Start:=34, Length:=9).Font

                .FontStyle = "Negrita"

            End With

        End If

        ' ---&--- Columna B

        Range("B" & Fila).Select

        If Len(ActiveCell.Text) > 0 Then

            Ps = InStr(ActiveCell.Text, "-") - 1

            With ActiveCell.Characters(Start:=1, Length:=Ps).Font

                .FontStyle = "Negrita"

            End With

        End If

    Next

    Range("A1").Select

End Sub

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Negrita solo a parte de celda

Publicado por Luis (60 intervenciones) el 17/11/2020 20:11:26

Me ha funcionado a la perfección, muchas gracias!

Y lo mejor es que me sirve para lo que necesite.

¿Cómo sería para algo más genérico?
Es decir, para todo lo que haya a partir o antes del segundo guion o cualquier delimitador que le pongas, por ejemplo. Segundo o tercero o lo que sea, quiero decir.

Si es mucho embrollo, no te preocupes ;)

Gracias de nuevo!

Valora esta respuesta

Comentar

Pos: 2

Val: 4.908

Negrita solo a parte de celda

Publicado por Antoni Masana (2479 intervenciones) el 17/11/2020 22:08:41

Solo es cuestión de buscar la posición y la longitud del texto a marcar.

Para buscar el primer guión tienes el Instr()

Ps = InStr(ActiveCell.Text, "-") - 1

Aquí le resto 1 para no incluir el guión.

Para buscar el último puedes hacerlo de varias formas:

Pos = 0

For a=1 to len(ActiveCell.Text)

    If Mid$(ActiveCell.Text, a,1) = "-" Then Pos = a

Next

Pos = 0

For a=len(ActiveCell.Text) To 1 Step -1

    If Mid$(ActiveCell.Text, a,1) = "-" Then Pos = a: Exit For

Next

Y la variable Pos tiene la posición del guión

With ActiveCell.Characters(Start:=Pos+1, Length:=...

Es cuestión de ir probando para encontrar el truco.

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 19

Val: 140

Negrita solo a parte de celda

Publicado por Luis (60 intervenciones) el 23/11/2020 13:59:21

Muchas gracias ;)

Valora esta respuesta

Comentar

Pos: 18

Val: 148

Negrita solo a parte de celda

Publicado por Norberto (46 intervenciones) el 25/11/2020 13:57:21

Hola:

Para buscar el último guión yo usaría InStrRev(...):

Ps = InStrRev(ActiveCell.Text, "-")

Un saludo,

Norberto.

Valora esta respuesta

Comentar

Consulta Planilla

Cómo saltarse un IF si en la celda A1 tiene la palabra "NO"