Indicación cuando Excel encuentre 3 consecutivos

Tengo tres columnas (A, B y C) con dos opciones posibles de dato en cada una de ellas (H o M en la columna A), (Y o Z en la columna B), (X o P en la columna C).

Los datos llegaran aproximadamente hasta la fila 600.

Lo que necesito  es que, cuando yo vaya añadiendo datos en las filas siguientes de las columnas A, B y C, el sistema, automáticamente detecte cuando hay 3 letras consecutivas iguales en una columna y me indique en las columnas D, E y F, respectivamente una indicación concreta pero en la fila siguiente y si la siguiente letra sigue siendo igual la indicación debe ser el doble que la anterior.

Ejemplos:

-Si en la columna “A" aparece 3 veces seguidas “H”, por ejemplo, en las filas A12, A13 y A14, deberá indicarme en D15 la indicación: "1M".

Si el siguiente dato de la siguiente fila (A15) es una "M" ya no indicara nada en (D16) y seguirá así hasta que de nuevo detecte 3 seguidas.

-Si en la columna B aparece 3 veces seguidas “Z”, por ejemplo, en las filas B14, B15 y B16 deberá indicarme en E17 la indicación : "1Y".

Si el siguiente dato de la siguiente fila (B17) es igual (otra "Z") deberá indicarme en E18: "2Y", o sea el doble que en la anterior.

Si el siguiente dato de la siguiente fila (B18) es también igual (otra "Z") deberá indicarme en E19: 4Y, o sea el doble que en la anterior...........y así sucesivamente

Como la explicación escrita puede resultar liosa tengo una explicación en una hoja de Excel en la que reflejo gráficamente lo que necesito. Si se necesita puedo enviarla sin problema.

3

3 Respuestas

4.465.750 pts. Sancho, si los perros ladran ...

Te anexo la macro para buscar los consecutivos de manera automática, cada vez que agregues datos a cualquier columna A, B o C.

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range("A:C")) Is Nothing Then
    Columns("D:F").ClearContents
    l1 = Array("H", "Z", "X", "M", "Y", "P")
    For i = LBound(l1) To 2
        ant = Cells(1, i + 1)
        con = 0
        nan = 1
        For j = 1 To Cells(Rows.Count, i + 1).End(xlUp).Row
            If ant <> UCase(Cells(j, i + 1)) Then
                con = 0
                nan = 1
            End If
            con = con + 1
            If con >= 3 Then
                Cells(j + 1, i + 4) = nan & IIf(ant = l1(i), l1(i + 3), l1(i))
                nan = nan * 2
            End If
            ant = Cells(j, i + 1)
        Next
    Next
End If
End Sub

Sigue las Instrucciones para poner la macro en worksheet y se ejecute en automático.

1. Abre tu libro de excel

2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11

3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)

4. Del lado derecho copia la macro               


Saludos. Dante Amor

Recuerda valorar la respuesta.

5.856.350 pts. Me voy x tiempo. Necesito hacer otras cosas, descansar...

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.

Pues no es tan sencillo, aparte de los sitios donde salen las letras de las columnas hay que cambiar varios sumandos de las jotas.

Yo creo que es esto pruébalo.

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("C:E")) Is Nothing Then
    Columns("G:I").ClearContents
    Datos = Array("H", "Z", "X", "M", "Y", "P")
    For j = 3 To 5
        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 - 3) And celda <> Datos(j)) Then
                UltChar = celda
                repes = 1
            Else
                repes = repes + 1
                If repes >= 3 Then
                    Cells(i + 1, j + 4) = 2 ^ (repes - 3) & IIf(UltChar = Datos(j - 3), Datos(j), Datos(j - 3))
                End If
            End If
        Next
    Next
End If
End Sub

Por favor, las preguntas que añadan algo nuevo a lo que se pedía al principio deben formularse en una pregunta nueva.

2.157.440 pts. En mi sitio encontraran material de ayuda, ejemplos...

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.

Es [email protected] y después sigue lo de yahoo.com.ar

De todos ya no me lo envíes porque ya se ha metido Dante a responder antes de que pueda acercarte una respuesta ... así que será en otra oportunidad.

Sdos

Elsa

PD) Estimado Dante... ¿no te han enseñado de chico que es de mala educación meterse en una conversación ajena? Si yo tomo una consulta espera a que le envíe mi propuesta y luego si te parece que tenés algo mejor para ofrecer, estás en todo tu derecho a intervenir.

PD2) Estimado ValeroAsm: aquí tienes el ranking de excel actualizado ;)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas