Necesito modificar esta macro de fibonacci

Buenas noches. Necesito modificar esta macro que contiene la serie de Fibonacci, pero lo que deseo es que la muestre como un diagrama de Gantt. Me explico mejor: que desde la celda "A2", empiece a colorear las celdas a partir de la ultima celda coloreada anterior(voy a dar un ejemplo para poder entrar en más detalles: supongamos que el valor de la celda "A1" sea 9, entonces la ultima celda coloreada seria la "J1", así que para el valor de la celda "A2" yo necesito que la primera celda a colorear sea la "K2" -no la "B2"- y así sucesivamente). Copio la macro:
Private Sub CommandButton1_Click()
Hoja1.Cells(1, 1) = Int(Rnd() * 10)
Hoja1.Cells(2, 1) = Int(Rnd() * 10)
i = 1
' Generación de la Serie de Fibonacci
    Do While i < 14
        Hoja1.Cells(i + 2, 1) = Hoja1.Cells(i, 1) + Hoja1.Cells(i + 1, 1)
        Hoja1.Cells(i, 1).Select
        i = i + 1
    Loop
Call Reducción
Call Ordenar
Call Borrarcolordiagrama
End Sub
Private Sub Reducción()
i = 1
' Generación de la serie anterior reducida a la unidad
    Do While i < 16
        Hoja1.Cells(i, 1) = Hoja1.Cells(i, 1) Mod 10
        i = i + 1
    Loop
End Sub
Private Sub Ordenar()
' Ordenar la serie reducida
Range("a1:a15").Select
Selection.Sort Key1:=Range("a1"), order1:=xlDescending, Header:=xlGuess, _
    ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    dataoption1:=xlSortNormal
End Sub
Private Sub Borrarcolordiagrama()
' Borrar color del Gantt anterior
Range("b1:j15").Select
Selection.Interior.ColorIndex = xlNone
' Diagrama de Gantt
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
    For i = 1 To 15
        x = Hoja1.Cells(i, 1)
        If x <> 0 Then
            For j = 2 To x + 1
                Hoja1.Cells(i, j).Select
                With Selection.Interior
                    .ColorIndex = x + 2
                    .Pattern = xlSolid
                End With
            Next j
        End If
    Next i
End Sub
Los cambios obviamente se hacen en Borrarcolordiagrama, y se que tengo que condicionar las celdas a partir de i=2 pero no se donde incluir el comando. Todo esto es porque estoy tratando de hacer una macro que cree mi propio diagrama de Gantt y este ejemplo me pareció un buen punto de partida, ya que aun no he podido encontrar un ejemplo que se acomode a lo que yo quiero hacer. Gracias por la respuesta.

1 respuesta

Respuesta
1
Te dejo solo la rutina que necesitaba del ajuste:
Private Sub Borrarcolordiagrama()
'x Elsamatilde
' Borrar color del Gantt anterior
Range("b1:CC15").Select     'indicar la mayor col posible
Selection.Interior.ColorIndex = xlNone
' Diagrama de Gantt
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
y = 2    'aquí empezamos en la col B
    For i = 1 To 15
        x = Hoja1.Cells(i, 1)
        If x <> 0 Then
            For j = y To y + x - 1
                Hoja1.Cells(i, j).Select
                With Selection.Interior
                    .ColorIndex = x + 2
                    .Pattern = xlSolid
                End With
            Next j
            y = j     'guardamos nro de la primer col sgte
        End If
    Next i
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas