Indicación cuando Excel encuentre 3 consecutivos

Espero haber entendido bien lo que pides.

Mira a ver si te sirve esta macro

Sub TresSeguidas()
Dim FilaFinal, Repes, i, j As Integer
Dim UltChar, celda, Datos(3, 2) As String
Datos(1, 1) = "H": Datos(1, 2) = "M"
Datos(2, 1) = "Y": Datos(2, 2) = "Z"
Datos(3, 1) = "X": Datos(3, 2) = "P"
For j = 1 To 3
    FilaFinal = Range(Chr(64 + j) & Rows.Count).End(xlUp).Row
    UltChar = ""
    Repes = 1
    For i = 1 To FilaFinal
        celda = UCase(Cells(i, j))
        If celda <> UltChar Then
            Repes = 1
            UltChar = celda
            Cells(i + 1, j + 3) = ""
        Else
            Repes = Repes + 1
            If Repes >= 3 Then
                If UltChar = Datos(j, 1) Then
                    Cells(i + 1, j + 3) = 2 ^ (Repes - 3) & Datos(j, 2)
                Else
                    Cells(i + 1, j + 3) = 2 ^ (Repes - 3) & Datos(j, 1)
                End If
            Else
                Cells(i + 1, j + 3) = ""
            End If
        End If
    Next
Next
End Sub

Espero que te sirva, si no es así dímelo.  Y si ya está bien, no olvides puntuar.

Donde hay un maestro y el número uno de Excel hay que observar y aprender, con permiso de Dante adapto mi macro con algunas mejoras de la suya.

No había pensado en hacer que se ejecutase automáticamente, si no son excesivos los datos de la hoja puede funcionar bien.

Bueno, yo mantengo mi estilo de declarar todas las variables, si sabemos que una variable es entera pienso que Excel trabajará mejor con ella que con el tipo variant. Y tampoco pongo nunca una complicada operación como límite de un bucle, la calculo antes y la pongo en una variable, asi no tiene que hacer esa operación complicada más que una vez.

Me habría ahorrado 4 líneas, pero mi estilo es mi estilo.

Y algo importante que se nos habia pasado es que si escribíamos 3 veces seguidas la Z en la columna A salía una indicación 1H o 1M, cuando solo debería aparecer si los caracteres son M o H. Para evitar eso pogo una instrucción un poco aparatosa pero es necesario.

Private Sub Worksheet_Change(ByVal Target As Range)
'ValeroASM y DAM
Dim i, j, FilaFinal, repes As Integer
Dim UltChar, celda As String
Dim Datos() As Variant
If Not Intersect(Target, Range("A:C")) Is Nothing Then
    Columns("D:F").ClearContents
    Datos = Array("H", "Z", "X", "M", "Y", "P")
    For j = 1 To 3
        UltChar = UCase(Cells(1, j))
        repes = 1
        FilaFinal = Cells(Rows.Count, j).End(xlUp).Row
        For i = 2 To FilaFinal
            celda = UCase(Cells(i, j))
            If celda <> UltChar Or (celda <> Datos(j - 1) And celda <> Datos(j + 2)) Then
                UltChar = celda
                repes = 1
            Else
                repes = repes + 1
                If repes >= 3 Then
                    Cells(i + 1, j + 3) = 2 ^ (repes - 3) & IIf(UltChar = Datos(j - 1), Datos(j + 2), Datos(j - 1))
                End If
            End If
        Next
    Next
End If
End Sub

Y eso es todo.

Hola Valero.

He estado probando las macros y funcionan perfectamente. Ya tengo casi resuelta mi necesidad.

Solo un matiz: ¿Qué modificación habría que hacerle a la macro "Private Sub Worksheet_Change" para que en vez de coger los datos iniciales de las columnas A, B y C los coja de las columnas C, D y E y las indicaciones en vez de ponerlas en las columnas D, E y F las ponga en las columnas G, H e I?

Gracias por su tiempo y su saber.

Un saludo

Icaros.

Si bien parece clara la solicitud, mejor enviame el Excel a mi correo (cibersoft_arg de yahoo.com.ar) para trabajarlo directamente en la muestra.

Hola.

Debe existir algún problema con la dirección de correo porque hotmail no me deja enviar el correo con el Excel explicativo.