Guardar Resultados En otra Hoja (VBA
Gracias a todo el que lea mi pregunta y en especial al que pueda responderla.
Lo que pasa que estoy programando en vba la simulación de una situación y para obtener resultados finales necesito hacerla 100 veces por lo que decidí meter todo el código dentro de un For y echarlo a andar 100 veces (o mas). Lo que pasa es que cada vez que lo haga, necesito que guarde el resultado de una variable en una Hoja diferente. Como resultado, me gustaría tener todos los resultados obtenidos en una columna de otra hoja.
1 Respuesta
Te regreso la macro con algunos cambios:
- Con el ciclo for hasta 3 (puedes cambiarlo a 100)
- Enviar los resultados a la hoja2
= Puse algunos comentarios de lo que agregué
Sub Método2()Application.ScreenUpdating = FalseApplication.DisplayStatusBar = TrueApplication.StatusBar = "Iniciando..." 'limpia hoja destinoSheets("Hoja2").Cells.Clear 'inicia forcf = 1For m = 1 To 3 col = 100 fil = 100 r = 7 i = fil / 2 j = col / 2 encuentra = False Pi = 3.14159265358979 Z = 0 falla = 0 blanco = False a = 0 b = 0 Z1 = Pi / 4 R1 = 3 d = 7 'x = Round(Application.RandBetween(1, fil - d)) 'y = Round(Application.RandBetween(1, col - d)) 'Calcular números aleatorios versión 2003 Do While True num = Int(Evaluate("=RAND()") * 100) If num > 1 And num < fil - d Then x = num Exit Do End If Loop Do While True num = Int(Evaluate("=RAND()") * 100) If num > 1 And num < col - d Then y = num Exit Do End If Loop 'Limpiar hoja Sheets("Hoja1").Cells.Clear Cells(x, y).Interior.ColorIndex = 1 y1 = y x1 = x While x < (x1 + d) y = y1 While y < (y1 + d) Cells(x, y).Interior.ColorIndex = 1 y = y + 1 Wend x = x + 1 Wend Do While (r <= col / 2) And (r <= fil / 2) And (encuentra = False) Z = 0 lf = 1 Do While (Z < 2 * Pi) And (encuentra = False) i = Round(fil / 2 + r * Cos(Z)) j = Round(col / 2 + r * Sin(Z)) If Cells(i, j).Interior.ColorIndex = 1 Then Cells(i, j).Interior.ColorIndex = 3 encuentra = True 'MsgBox "Se han realizado " & falla & " perforaciones fallidas hasta encontrar petroleo.", vbExclamation, "Resultado Final" 'MsgBox "Se encontró petroleo en el punto: (" & i & "," & j & ") ; Comenzará la inspección específica.", vbInformation, petroleo Sheets("Hoja2").Cells(lf, cf + 1) = "Se han realizado " & falla & " perforaciones fallidas hasta encontrar petroleo." Sheets("Hoja2").Cells(lf, cf + 2) = "Se encontró petroleo en el punto: (" & i & "," & j & ") ; Comenzará la inspección específica." a = i b = j Do While (blanco = False) Z1 = Pi / 4 Do While (blanco = False) And (Z1 < 2 * Pi) a = Round(i + R1 * Cos(Z1)) b = Round(j + R1 * Sin(Z1)) 'agregué las siguientes condiciones, porque en ocasiones se excedía de los límites de la hoja y envía error If a > 0 And b > 0 Then If a < 100 And b < 100 Then If Cells(a, b).Interior.ColorIndex = 2 Then blanco = True 'MsgBox "El pozo tiene un diametro estimado de " & 2 * R1 - 6 & " mts." Sheets("Hoja2").Cells(lf, cf + 3) = "El pozo tiene un diametro estimado de " & 2 * R1 - 6 & " mts." Else Cells(a, b).Interior.ColorIndex = 3 End If Else blanco = True Exit Do End If Else Exit Do End If Z1 = Z1 + (Pi / 2) Loop R1 = R1 + 3 Loop Else Cells(i, j).Interior.ColorIndex = 43 End If Z = Z + (Pi / 4) falla = falla + 1 'agrega el contador falla a la hoja2 Sheets("Hoja2").Cells(lf, cf) = falla lf = lf + 1 Loop r = r + 7 Loop 'cambia la columna para el siguiente ciclo del for cf = cf + 4 lf = 1 Next Application.ScreenUpdating = TrueApplication.StatusBar = "Ejecución terminada."End Sub
Prueba y dime si es más o menos lo que necesitas.
Saludos. DAM
