Rutina para contar caracteres subrayados en una cadena de texto.

Hola buenos días expertos. Necesito vuestra ayuda, estoy buscando una rutina para contar caracteres subrayados en una cadena de texto. Tengo una celda en la que hay una serie de números separados por una coma en la que hay algunos que están subrayados y otros no (1,2,3,10,25,30). ¿Existe alguna rutina para poder contar los subrayados y que me indique el número en otra celda?. Los subrayados son de color rojo y los otros negro.

Saludos y gracias de antemano

1 Respuesta

Respuesta
2

Te anexo la macro, cambia en la macro "B5" por la celda que quieres revisar.

Sub ContarSubrayados()
'Por.Dante Amor
    Set celda = Range("B5")
    For i = 1 To Len(celda)
        If celda.Characters(Start:=i, Length:=1).Font.Underline = 2 Then
            n = n + 1
        End If
    Next
    celda.Offset(0, 1) = n
End Sub

El resultado de la macro te lo pondrá en la siguiente celda, en mi ejemplo, pondrá el resultado en la celda C5.


Sigue las Instrucciones para ejecutar la macro

  1. Abre tu archivo de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. En el menú elige Insertar / Módulo
  4. En el panel del lado derecho copia la macro
  5. Para ejecutarla presiona F5

Hola Dante

gracias por tu respuesta. Funciona perfectamente con los números de un digito, pero tengo un problema con los números de 2 dígitos ya que al contar caracteres, estos me los cuenta como 2 números y necesito que los cuente como un solo número. No se si se puede hacer. La numeración que puede haber en la celda va, como máximo del 1 al 31.

gracias de antemano

Prueba con la siguiente macro.

Sub ContarSubrayados()
'Por.Dante Amor
    Set celda = Range("B5")
    caracter = False
    empieza = True
    For i = 1 To Len(celda)
        num = Mid(celda.Value, i, 1)
        If num <> "" And num <> "," And celda.Characters(Start:=i, Length:=1).Font.Underline = 2 Then
            caracter = True
        End If
        If caracter And empieza Then
            n = n + 1
            empieza = False
        End If
        If Mid(celda.Value, i, 1) = "," Then
            empieza = True
        End If
        caracter = False
    Next
    celda.Offset(0, 1) = n
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas