Mehrstufiger Loop

Hallo ForumsGemeinde,
ich arbeite zur Zeit an einem Bewertunggsystem das bestimmte Vorgänge bewerten soll.
Auf der einen Seite gibt es dazu die Datenbank.xls und das Bewertungssystem.xls.
Innerhalb des Bewertunggsystemes werden die einzelnen Vorgänge aufgerufen, bewertet und weiter kopiert.
folgende Schritte sind für das Grundmakro nötig:
1. Vorgangs-ID kopieren, beginnen bei Zeile A2, über A3,A4...usw bis
2. Die kopierte ID in das Bewertungssystem einfügen, also Sheetwechsel
3. in einen feste Positionkopieren "A3". Aus dieser Positionheraus greift das Bewertunggssystem
4. Das Bewertunggsystem gibt einen prozentualen Wert als Ergebniss aus, in "D55", kopieren
5. Ergebniss in L3 einfügen, bzw. in L4 für A4 usw.
Die Schritte eins 1. bis 5. habe ich soweit geschrieben, das klappt auch einigermaßen.
Was ich nicht hinkriege, ist der Loop. Bei meinem Makro passiert dieser ganze Prozess nur einmal mit der ID aus A3. Ich schaffe es nicht den Prozess für alle weiteren ID's aufzubauen.
Besonders da 1. fortlaufend ist, 3. absolut, 4. absolut, und 5. fortlaufend.
im folgenden habe ich meinen bisherigen Fortschritt beigefügt:

Sub Vorgangsbewertung()
x = Range("A2").Row
y = Range("A2").Column
Z = 0
Do While Cells(x, y).Value  ""
x = x + 1
Z = Z + 1
Windows("Daten.xlsx").Activate ' Wechsel zur Datenbank
Range("A2").Select ' Auswahl der Vorgangs-ID
Selection.Copy ' Kopie der Vorgangs-ID
Windows("Bewertunggsystem.xlsm").Activate ' Wechsel zum Bewertungssystem
Sheets("Bewertung").Select
Range("A3").Select ' Auswahl des Pfeldes, welches die Bearbeitung des Vorganges einleitet
ActiveSheet.Paste ' Einfügen der Vorgangs-ID
' Bewertung erfolgt durch Bewertungssystem
Range("D56").Select ' Auswahl der ausgegebenen Bewertung
Selection.Copy ' Kopie der Bewertung
Sheets("Auswertung").Select ' Wechsel zum Glossar der Auswertung
Range("L3").Select ' Auswahl des Feldes für die Auswertung
Selection.PasteSpecial Paste:=xlPasteValues ' Einfügen der Auswertung, nur der Wert
Loop
MsgBox "Es wurden " & Z & " Vorgänge aktualisiert"
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Vorgangsbewertung() x = Workbooks("Daten.xlsx").Sheets(1).Range("A2").Row 'Blattname richtig? Evtl. ändern! y = Workbooks("Daten.xlsx").Sheets(1).Range("A2").Column Z = 0 Do While Workbooks("Daten.xlsx").Sheets(1).Cells(x, y).Value "" 'Mappe richtig? x = x + 1 Z = Z + 1 Workbooks("Bewertunggsystem.xlsm").Sheets("Bewertung").Range("A3").Value = _ Workbooks("Daten.xlsx").Sheets(1).Range("A2").Value 'Blattname richtig? Evtl. ä _ ndern! ' Bewertung erfolgt durch Bewertungssystem Workbooks("Bewertunggsystem.xlsm").Sheets("Ausertung").Range("L3").Value = _ Workbooks("Bewertunggsystem.xlsm").Sheets("Bewertung").Range("D56").Value ' _ Blattname richtig? Evtl. ändern! Loop MsgBox "Es wurden " & Z & " Vorgänge aktualisiert" End Sub

Sub Vorgangsbewertung() lZ = Workbooks("Daten.xlsx").Sheets(1).Range("A2").End(xlDown).Row Z = 0 for i=2 to lZ Z = Z + 1 Workbooks("Bewertungssystem.xlsm").Sheets("Bewertung").Range("A3").Value = _ Workbooks("Daten.xlsx").Sheets(1).cells(i,1).Value ' Bewertung erfolgt durch Bewertungssystem Workbooks("Bewertungssystem.xlsm").Sheets("Auswertung").Range("L3").Value = _ Workbooks("Bewertungssystem.xlsm").Sheets("Bewertung").Range("D56").Value Loop MsgBox "Es wurden " & Z & " Vorgänge aktualisiert" End Sub

Sub Vorgangsbewertung() x = Workbooks("Daten.xlsx").Sheets(1).Range("A2").Row y = Workbooks("Daten.xlsx").Sheets(1).Range("A2").Column 'hier könnte man auch einfach x=2 und y=1 setzen Z = 0 Do While Workbooks("Daten.xlsx").Sheets(1).Cells(x, y).Value "" Z = Z + 1 Workbooks("Bewertungssystem.xlsm").Sheets("Bewertung").Range("A3").Value = _ Workbooks("Daten.xlsx").Sheets(1).Cells(x, y).Value x = x + 1 'diese Addition hier, sonst fängt es bei A3 an und nicht bei A2 ' Bewertung erfolgt durch Bewertungssystem Workbooks("Bewertungssystem.xlsm").Sheets("Ausertung").Range("L3").Value = _ Workbooks("Bewertungssystem.xlsm").Sheets("Bewertung").Range("D56").Value Loop MsgBox "Es wurden " & Z & " Vorgänge aktualisiert" End Sub

Hallo Herr Frank,
das sieht soweit super aus. Vielen lieben Dank schonmal!
Der Vorgang läuft Reibungslos durch, und gibt auch die entsprechende Meldung richtig aus.
Innerhalb des Prozesses funktioniert eine Teilfunktion jedoch nicht.
und zwar folgendes:
' Bewertung erfolgt durch Bewertungssystem
Workbooks("Bewertungssystem.xlsm").Sheets("Auswertung").Range("L3").Value = _
Workbooks("Bewertungssystem.xlsm").Sheets("Bewertung").Range("D56").Value
Hier fehlt noch ein kleiner zwischen Schritt nehme ich an.
Das Sheet Bewertung können Sie sich wie folgt vorstellen
In A3 wird die Vorgangs ID eingefügt, das klappt auch soweit ich das nachvollziehen kann reibungslos. Zumindestens steht nach Ausführen des Makros die letzte Vorgangs ID noch in A3.
Nach einfügen der ID folgt eine automatische Auswertung.
In A4 steht zum Beispiel die erste Kennzahl, zum Beispiel Angebot größer XY.
Diese Form der Bewertung zieht sich durch das ganze Dokument und funktioniert auch bisher reibungslos.
Die Bewertung erfolgt durch einen SVERWEIß und wird in Form von 1 und 0 aufaddiert.
Je höher die Punktzahl, desto besser die Bewertung.
In Zeile D56 wird die Punktzahl in eine Prozentzahl umgewandelt.
Diese Prozentzahl wird dann in L3 kopiert, bzw. sollte kopiert werden. Mit Ausführen des Makros wird immer nur die Prozentzahl der ersten ID kopiert, der Rest bleibt leer.
Hast du hier vielleicht noch eine Idee wie man weiter vorgehen könnte?
Liebe Grüße,
Christian

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread