Scalextric,¿Se pude hacer?
Hola Cadipas,
Tu macro funciona perfectamente,era yo que no me entero de la pelicula,un compañero mio la activo ayer,me gustaria pedirte un ultimo favor;¿es posible crear en tu macro tres grupos de 6 columnas?es para poder hacer tres carreras el mismo dia e ir viendo los tiempos minimos de todas ellas,te dejo otro grafico donde se ve mejor.
Muchas gracias por tu atencion de parte mia y de mis compañeros.
Un salodo.Pedro.
Tu macro funciona perfectamente,era yo que no me entero de la pelicula,un compañero mio la activo ayer,me gustaria pedirte un ultimo favor;¿es posible crear en tu macro tres grupos de 6 columnas?es para poder hacer tres carreras el mismo dia e ir viendo los tiempos minimos de todas ellas,te dejo otro grafico donde se ve mejor.
Muchas gracias por tu atencion de parte mia y de mis compañeros.
Un salodo.Pedro.
Respuesta de Cadipas spain
1
Ya puedes cerrar y valorar la pregunta. Ya que te he enviado el fichero. Para el resto de foreros la solución ha sido:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim COLOR As Byte
Dim A As Double
Dim W As Double
Dim K As Double
Dim N As Double
Dim AA(50) As Double
Dim WW(50) As Double
Dim KK(50) As Double
Dim NN(50) As Double
If Target.Row < 20 And Target.Row > 1 Then
If Target.Column < 26 And Target.Column > 7 Then
Range(Cells(2, 8), Cells(19, 24)).Interior.ColorIndex = xlNone
For paso = 0 To 12 Step 6
For c = 8 + paso To 12 + paso
For r = 2 To 19
If IsNumeric(Cells(r, c)) Then
Select Case Cells(r, 7)
Case "A"
AA(c) = Cells(r, c)
If A = 0 Then
A = AA(c)
RA = r
End If
If A > AA(c) Then
A = AA(c)
RA = r
End If
Case "W"
WW(c) = Cells(r, c)
If W = 0 Then
W = WW(c)
RW = r
End If
If W > WW(c) Then
W = WW(c)
RW = r
End If
Case "K"
KK(c) = Cells(r, c)
If K = 0 Then
K = KK(c)
RK = r
End If
If K > KK(c) Then
K = KK(c)
RK = r
End If
Case "N"
NN(c) = Cells(r, c)
If N = 0 Then
N = NN(c)
RN = r
End If
If N > NN(c) Then
N = NN(c)
RN = r
End If
End Select
End If
Next r
If Cells(RA, c) <> "" Then Cells(RA, c).Interior.ColorIndex = Cells(RA, 7).Interior.ColorIndex
If Cells(RW, c) <> "" Then Cells(RW, c).Interior.ColorIndex = Cells(RW, 7).Interior.ColorIndex
If Cells(RK, c) <> "" Then Cells(RK, c).Interior.ColorIndex = Cells(RK, 7).Interior.ColorIndex
If Cells(RN, c) <> "" Then Cells(RN, c).Interior.ColorIndex = Cells(RN, 7).Interior.ColorIndex
A = 0
W = 0
K = 0
N = 0
Next c
Next paso
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim COLOR As Byte
Dim A As Double
Dim W As Double
Dim K As Double
Dim N As Double
Dim AA(50) As Double
Dim WW(50) As Double
Dim KK(50) As Double
Dim NN(50) As Double
If Target.Row < 20 And Target.Row > 1 Then
If Target.Column < 26 And Target.Column > 7 Then
Range(Cells(2, 8), Cells(19, 24)).Interior.ColorIndex = xlNone
For paso = 0 To 12 Step 6
For c = 8 + paso To 12 + paso
For r = 2 To 19
If IsNumeric(Cells(r, c)) Then
Select Case Cells(r, 7)
Case "A"
AA(c) = Cells(r, c)
If A = 0 Then
A = AA(c)
RA = r
End If
If A > AA(c) Then
A = AA(c)
RA = r
End If
Case "W"
WW(c) = Cells(r, c)
If W = 0 Then
W = WW(c)
RW = r
End If
If W > WW(c) Then
W = WW(c)
RW = r
End If
Case "K"
KK(c) = Cells(r, c)
If K = 0 Then
K = KK(c)
RK = r
End If
If K > KK(c) Then
K = KK(c)
RK = r
End If
Case "N"
NN(c) = Cells(r, c)
If N = 0 Then
N = NN(c)
RN = r
End If
If N > NN(c) Then
N = NN(c)
RN = r
End If
End Select
End If
Next r
If Cells(RA, c) <> "" Then Cells(RA, c).Interior.ColorIndex = Cells(RA, 7).Interior.ColorIndex
If Cells(RW, c) <> "" Then Cells(RW, c).Interior.ColorIndex = Cells(RW, 7).Interior.ColorIndex
If Cells(RK, c) <> "" Then Cells(RK, c).Interior.ColorIndex = Cells(RK, 7).Interior.ColorIndex
If Cells(RN, c) <> "" Then Cells(RN, c).Interior.ColorIndex = Cells(RN, 7).Interior.ColorIndex
A = 0
W = 0
K = 0
N = 0
Next c
Next paso
End If
End If
End Sub
