MAKRO FUNKTIONIERT ERST BEIM 2. MAL RICHTIG
26.10.2005 10:51:01
Johannes
Folgend ist der etwas länger Code einens Makros, dass in einer Tabelle (final) automatisch Werte aus einer anderen Tabelle (Nietparameter) zuweisen und darauf Wert berechnen soll.
Das komische ist, dass die Werte erst stimmen wenn ich das Makro ein 2 mal laufen lasse.
Zudem funktioniert ziemlich weit unten die Berechnung RF nicht richtig. Es kommt zu einem Überlauf der Variablen.
Bin schon ziemlich verzweifelt. Hoffe auf eure Hilfe!
DANKE
Johannes
Sub schritt8_auto_berechnung()
Dim iZeile As Long, LetzteZeile As Long
Dim a As Long
Dim aa As Double
Dim i As Long
With Sheets("final")
LetzteZeile = Range("A65536").End(xlUp).Row
For iZeile = 4 To LetzteZeile
Cells(iZeile, 13) = Cells(iZeile, 6) - 2
If (8 - Cells(iZeile, 13)) / 2 < 0 Then
a = (8 - Cells(iZeile, 13)) / 2
Else
a = 0
End If
If Cells(iZeile - 1, 13) < a Or Cells(iZeile + 1, 13) < a Then
Cells(iZeile, 14) = Application.WorksheetFunction.Min(Cells(iZeile - 1, 6), Cells(iZeile + 1, 6))
Else
If (8 - Cells(iZeile, 13)) / 2 > 0 Then
Cells(iZeile, 14) = (8 - Cells(iZeile, 13)) / 2
Else
Cells(iZeile, 14) = 0
End If
End If
'Löschen unnötiger Zeilen
If Cells(iZeile, 3) = "" Then
Cells(iZeile, 13).Clear
Cells(iZeile, 14).Clear
Cells(iZeile, 15).Clear
Cells(iZeile, 16).Clear
Cells(iZeile, 17).Clear
Cells(iZeile, 18).Clear
End If
'Einordnen der zugehörigen Nietparameter
If Sheets("final").Cells(iZeile, 5) = "1097-DD5" Or Sheets("final").Cells(iZeile, 5) = "9198-40" Or Sheets("final").Cells(iZeile, 5) = "9199-40" Then
For i = 1 To 170
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 8).Value Then
Sheets("NIETPARAMETER").Cells(i, 5).Copy
Cells(iZeile, 16).Insert
End If
Next i
For i = 1 To 170
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 7).Value Then
Sheets("NIETPARAMETER").Cells(i, 14).Copy
Cells(iZeile, 17).Insert
End If
Next i
End If
If Sheets("final").Cells(iZeile, 5) = "1097-DD6" Or Sheets("final").Cells(iZeile, 5) = "1097-KE6" Or Sheets("final").Cells(iZeile, 5) = "9199-48" Then
For i = 1 To 170
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 8).Value Then
Sheets("NIETPARAMETER").Cells(i, 6).Copy
Cells(iZeile, 16).Insert
End If
Next i
For i = 1 To 170
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 7).Value Then
Sheets("NIETPARAMETER").Cells(i, 15).Copy
Cells(iZeile, 17).Insert
End If
Next i
End If
If Sheets("final").Cells(iZeile, 5) = "HL11-5" Then
For i = 1 To 170
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 8).Value Then
Sheets("NIETPARAMETER").Cells(i, 20).Copy
Cells(iZeile, 16).Insert
End If
Next i
For i = 1 To 170
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 7).Value Then
Sheets("NIETPARAMETER").Cells(i, 33).Copy
Cells(iZeile, 17).Insert
End If
Next i
End If
If Sheets("final").Cells(iZeile, 5) = "HL11-6" Then
For i = 1 To 160
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 8).Value Then
Sheets("NIETPARAMETER").Cells(i, 21).Copy
Cells(iZeile, 16).Insert
End If
Next i
For i = 1 To 170
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 7).Value Then
Sheets("NIETPARAMETER").Cells(i, 34).Copy
Cells(iZeile, 17).Insert
End If
Next i
End If
If Sheets("final").Cells(iZeile, 5) = "HL11-8" Then
For i = 1 To 160
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 8).Value Then
Sheets("NIETPARAMETER").Cells(i, 24).Copy
Cells(iZeile, 16).Insert
End If
Next i
For i = 1 To 170
If Sheets("NIETPARAMETER").Cells(i, 1).Value = Cells(iZeile, 7).Value Then
Sheets("NIETPARAMETER").Cells(i, 37).Copy
Cells(iZeile, 17).Insert
End If
Next i
End If
Cells(iZeile, 16) = Cells(iZeile, 16) / 10
Cells(iZeile, 17) = Cells(iZeile, 17) / 10
'Minimalberchnung --> ist aus irgendwelchen Gründen nicht direkt gegangen
Cells(iZeile, 18) = Sheets("NIETPARAMETER").Application.WorksheetFunction.Min(Cells(iZeile, 17), Cells(iZeile, 16))
'Berechnung ACTUAL PANELLOAD
If Cells(iZeile - 1, 3) = "" Then
Cells(iZeile, 15) = Cells(iZeile, 6) * Cells(iZeile, 10) + Cells(iZeile, 14) * Cells(iZeile + 1, 10)
Else
Cells(iZeile, 15) = Cells(iZeile, 6) * Cells(iZeile, 10) + Cells(iZeile, 14) * Cells(iZeile - 1, 10) + Cells(iZeile, 14) * Cells(iZeile + 1, 10)
End If
'Berechnug ALLOWABLE PANELLOAD
'If Cells(iZeile - 1, 3) = "" Then
'Cells(iZeile, 19) = Cells(iZeile, 18) * Cells(iZeile, 13) + Cells(iZeile + 1, 18) * Cells(iZeile, 14)
'Else
aa = (Cells(iZeile, 13).Value * Cells(iZeile, 18).Value) + (Cells(iZeile, 14).Value * Cells(iZeile - 1, 18).Value) + (Cells(iZeile, 14).Value * Cells(iZeile + 1, 18).Value)
Debug.Print aa
Cells(iZeile, 19).Value = (Cells(iZeile, 13).Value * Cells(iZeile, 18).Value) + (Cells(iZeile, 14).Value * Cells(iZeile - 1, 18).Value) + (Cells(iZeile, 14).Value * Cells(iZeile + 1, 18).Value)
Cells(iZeile, 20).Value = ""
'End If
'Berechnung RF -> funktioniert nicht?
'Cells(iZeile, 20) = Application.WorksheetFunction.RoundUp(Cells(iZeile, 19) / Cells(iZeile, 15), 2)
Next iZeile
End With
End Sub