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.
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 de Elsa Matilde
1