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.
1

1 Respuesta

87.350 pts. Aficionado Execel y Macros etc
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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas