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 Respuestas
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 SubSigue 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.
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 SubY 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 SubPor favor, las preguntas que añadan algo nuevo a lo que se pedía al principio deben formularse en una pregunta nueva.
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 cibersoft_arg@ 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 ;)