Anzeige
Archiv - Navigation
684to688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
684to688
684to688
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

MAKRO FUNKTIONIERT ERST BEIM 2. MAL RICHTIG

MAKRO FUNKTIONIERT ERST BEIM 2. MAL RICHTIG
26.10.2005 10:51:01
Johannes
Hallo Leute!
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

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: MAKRO FUNKTIONIERT ERST BEIM 2. MAL RICHTIG
26.10.2005 11:25:37
Johannes
WICHTIG!!!
BITTE UM ANTWORTEN!!
AW: MAKRO FUNKTIONIERT ERST BEIM 2. MAL RICHTIG
26.10.2005 11:31:17
Herbert
Hi,
Großschreibung gilt im Net als brüllen, das wird nicht gerade gern gesehen.
mfg Herbert
AW: MAKRO FUNKTIONIERT ERST BEIM 2. MAL RICHTIG
26.10.2005 11:31:48
Andi
Hi,
schrei doch nich so rum hier, Dein Beitrag wird auch dann gelesen, wenn Du 'Caps Lock' wieder ausschaltest...
Zum zweiten Problem:
den Überlauf kann ich nur dann reproduzieren, wenn in Cells(iZeile, 15) entweder 0 oder nix steht, Division durch 0 ergibt nunmal unendlich -&gt Überlauf.
Zum ersten Problem:
Wär ned schlecht, wenn Du vielleicht a bisserl mehr ins Detail gehen würdest; welche Berechnungen bringen das falsche Ergebnis, wie sieht das falsche Ergebnis aus, wie sähe das richtige aus...?
Kann sicher auch nicht schaden, mal Deine Mappe hochzuladen.
Schönen Gruß,
Andi
Anzeige
Sorry fürs Brüllen
26.10.2005 11:51:23
Johannens
Hallo!
Danke für die Antwort.
Leider ist das File größer als 300 KB. Habs schon auf die relevanten Datenmenge gekürzt. Ist aber immer noch zuviel.
Es geht um die Berechnung des Allowable Panelload ist eigentlich nicht schwierig. Sie liefert aber erst beim zweiten Durchlauf die richtigen Ergebnisse. Kann es sein, dass die Zellen mit Werten gefüllt sein müssen, bevor das Programm richtig rechnet?
Mit freundlichen Grüßen,
Johannes
AW: Sorry fürs Brüllen
26.10.2005 12:14:19
Andi
Hi,
so wirklich nachvollzogen hab ich jetz noch nicht, was Dein Makro macht bzw machen soll (dafür fehlt mir auch leider a bisserl die Zeit), aber eins ist mir aufgefallen:
Am Anfang des Makros steht
With Sheets("final")
Ich vermute deshalb, dass sich deshalb alle Zell-Angaben wie
Cells(izeile, irgendwas) auf dieses sheet beziehen; allerdings klappt das nur, wenn entweder das sheet "final" zufällig gerade aktiv ist, oder wenn Du die Zellen im Code mit einem Punkt davor referenzierst:
.Cells(izeile, irgendwas)
Ich hoffe, damit zur Lösung beigetragen zu haben.
Schönen Gruß,
Andi
Anzeige
AW: MAKRO FUNKTIONIERT ERST BEIM 2. MAL RICHTIG
26.10.2005 11:38:07
Harald
Hi Johannes,
auf den ersten Blick hat dein Code etwa 157456 Leerzeichen zuviel ;-))
Das macht es den Helfern schonmal schwer, da überhaupt durchzusteigen.
Zusätzlich kommt die Frage auf. Welche Fehler tauchen auf, gibt es Fehlermeldungen ? und wo, wann , welche ?
Mangels Musterdatei und Fehlerinfo müßte man versuchen deine Datei nachbauen...
Würde ich nicht viel geld drauf wetten, dass das jemand tut ;-)))
Tipp: Geh den Code mit F8 Schritt für Schritt durch und schau dir an, was die Variablen machen (Wertangabe bei Mouseover)
Hilft das nicht, abgespeckte Musterdatei hochladen....liebenswürdigerweise mit 70% weniger Leerzeichen und exakten Angaben zu den Fehlern.
Wie gesagt...gut gemeinter Tipp
Gruß
Harald
Anzeige
Code bereinigt
26.10.2005 12:01:08
Johannes
'schritt 8: Berechnungen sollen automatisch durchgeführt werden

Sub schritt8_auto_berechnung()
Dim iZeile As Long, LetzteZeile As Long
Dim a As Long
Dim i As Long
With Sheets("final")
LetzteZeile = Range("A65536").End(xlUp).Row
For iZeile = 4 To LetzteZeile
' Die Zellen vorher werden richtig gefüllt vom Programm -> Es stehen überall die richtigen Werte!
'Berechnug ALLOWABLE PANELLOAD
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)
'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

Anzeige
AW: Code bereinigt
26.10.2005 12:36:06
Harald
Hi Johannes,
hab's mal nachgebaut und es gab Fehlermeldungen, hauptsächlich wenn irgendwo in der RoundUp-Matrix Nullwerte standen.
on error resume next könnte die Sache abfangen.
Zumindest hab ich das folgendermassen erfolgreich getestet.

Sub test()
On Error Resume Next
For iZeile = 1 To 3
Cells(iZeile, 2) = WorksheetFunction.RoundUp(Cells(iZeile, 3) / Cells(iZeile, 4), 2)
Next iZeile
End Sub

Viel Erfolg
Harald

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige