Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1368to1372
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1368to1372
1368to1372
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Do until Loop

Do until Loop
09.07.2014 14:10:55
Hans
Hallo
Habe ein Problem bei dem ich einfach nicht weiterkomme
Habs mit dem Macrorekorder so hinbekommen das ich den code manuell abreche
geht aber bestimmt besser
Habe einfach den Kopf kopiert und angepasst an die nächste zeile
zeilen sollen von E19 nach unten bis er auf eine leere zeile trifft abgearbeitet werden
Mein Code wurde natürlich so ziehmlich lange und Excel hat gemeckert :-(
Sub Test()
'
' Test Makro
' Automatische Bestellungserfassung erstellt am 16.10.2013
'
Sheets("Lieferschein").Select
Range("E19").Select
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("B11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("B19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("C11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("H19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("D11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("H15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("E11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("C19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("F11").Select
ActiveSheet.Paste
Application.Run _
"Fertigungsplanung_.xlsm!EingabeDatenProdAuftrag_Bestellung"
Sheets("Lieferschein").Select
Range("E20").Select
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("B11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("B20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("C11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("H20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("D11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("H15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("E11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("C20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("F11").Select
ActiveSheet.Paste
Application.Run _
"Fertigungsplanung_.xlsm!EingabeDatenProdAuftrag_Bestellung"
Sheets("Lieferschein").Select
Range("E21").Select
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("B11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("B21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("C11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("H21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("D11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("H15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("E11").Select
ActiveSheet.Paste
Sheets("Lieferschein").Select
Range("C21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Eingabe Daten Prod. Auftrag").Select
Range("F11").Select
ActiveSheet.Paste
Application.Run _
"Fertigungsplanung_.xlsm!EingabeDatenProdAuftrag_Bestellung"
u.s.w

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Do until Loop
09.07.2014 14:27:28
Rudi
Hallo, 
Sub Test()
Dim lRow As Long
lRow = 14
With Sheets("Lieferschein")
Do
.Range("E19").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("B11")
.Range("B19").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("C11")
.Range("H19").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("D11")
.Range("H15").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("E11")
.Range("C19").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("F11")
Application.Run _
"Fertigungsplanung_.xlsm!EingabeDatenProdAuftrag_Bestellung"
lRow = lRow + 1
Loop While .Cells(lRow, 5)  ""
End With
End Sub

Gruß
Rudi

Anzeige
AW: Kleiner Tip
09.07.2014 14:33:13
Daniel
mit dem Recorder aufgezeichneten Code solltest du immer so wie hier beschrieben überarbeiten:
http://www.online-excel.de/excel/singsel_vba.php?f=78
das macht den Code kürzer, übersichlicher, schneller, weniger fehleranfällig.
dadurch wird es auch für uns leichter, deinen Code zu verstehen, wenn du Probleme mit ihm hast und ihn hier einstellst.
Gruß Daniel

Variante
09.07.2014 15:23:30
Michael
Hallo Hans,
wenn ich schon damit rumgespielt hab, will ich es auch loswerden...
Rudis Lösung hat ja schon die optimalen Randbedingungen (mache, solange Daten vorhanden).
Oft reicht eine einfache Zuweisung von Werten:
Sub Test()
For ZeileNr = 19 To 21
Sheets("Eingabe Daten Prod. Auftrag").Range("B11").Value = _
Sheets("Lieferschein").Range("E" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("C11").Value = _
Sheets("Lieferschein").Range("B" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("D11").Value = _
Sheets("Lieferschein").Range("H" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("E11").Value = _
Sheets("Lieferschein").Range("H15").Value
Sheets("Eingabe Daten Prod. Auftrag").Range("F11").Value = _
Sheets("Lieferschein").Range("C" & ZeileNr).Value
Next ZeileNr
End Sub
Abgesehen davon: das Kopieren von H15 nach E11 kannst Du Dir schenken, indem Du einfach in "Lieferschein" in E11 reinschreibst: =Lieferschein!H15
Happy Exceling,
Michael

Anzeige
AW: Variante
09.07.2014 16:02:15
Michael
... in "Eingabe Daten usw." E11 meine ich natürlich.

AW: Do until Loop
09.07.2014 15:49:41
Hans
Hallo Rudi vielen Dank für deine Hilfe
Funktioniert so aber nicht
Habe meine Excel mappe hochgeladen musste ich auf Upload machen da meine Mappe 3mb hatt :-)
Wenn du nun bei Tabelle "Eingabe Daten Prod.Auftrag" auf das obige Makro Bestellung Erfassen von Lieferschein HMPR klickts siehst du mein Problem ,muss manuell abrechen :-()
Link zur Mappe : http://www.file-upload.net/download-9190704/Fertigungsplanung_Allemann.xlsm.html
Vielen Dank für deine Bemühungen

Anzeige
AW: Do until Loop
10.07.2014 13:59:42
Michael
Hallo Hans,
ich weiß nicht, ob ich mit meiner Vermutung richtig liege. Du gibst ja selbst an, kaum EXCEL/VBA-Kenntnisse zu haben, und trotzdem mußt Du Dich mit solchen Problemen herumschlagen. Ich hab selbst schon erlebt, daß man eine Arbeit reingewürgt bekommt, von Leuten, die gar nicht wissen, was für ein Aufwand dahinter steckt, sowohl was Zeit als auch Kenntnisse angeht.
Man kriegt das schon irgendwie hin, aber so Sätze wie: "Herr Mustermann, Sie kennen sich doch mit Excel aus, also machen Sie mal schnell dies und das" habe ich gefressen. Nach Deiner Einschätzung kennst Du Dich eben nicht (besonders gut) aus.
Dein Arbeitgeber wird nicht hocherfreut sein, wenn Du eine Tabelle mit allen möglichen "echten" Daten ins Netz stellst.
Und ich für meinen Teil bin es auch nicht: ich mag mir die Platte nicht mit 2 MB fremder Daten vollmüllen, geschweige denn eine (wie beim ersten link oben) .EXE auf meinem Rechner ausführen, deren Herkunft ich nicht kenne, auch wenn es nur ein harmloses selbstextrahierendes Archiv sein mag. Wenn.
Also bitte: lege eine neue, überschaubare Tabelle an, anhand derer wir das Problem nachvollziehen können, und lade die ins Forum.
Übrigens sehe ich bei Deinem letzten link nur eine Fehlermeldung.
Schöne Grüße,
Michael

Anzeige
AW: Do until Loop
10.07.2014 14:52:22
Hans
Hallo Michael,
Da gebe ich dir Recht
Weil ich schon circa ein halbes jahr am Makro herumm bastel und es nicht so hinbekomme wie ich das gern hätte, dachte ich mir einer von euch könnte das ja mal anschauen
Ich werde das ganze in einer neuen tabelle anlegen und hochladen aber nur schon das kostet mich wieder viel zeit ,denn meine Mappe hatt sicher an die 50 Makros mit ebenso vielen Verknüpfungen
Trotzdem Danke für den Tip :-)

AW: Do until Loop
11.07.2014 08:51:39
Hans
Hallo also wenn ich die Zeilenanzahl kenne dann Funktionierts, ich hätte aber gerne dass er ne Schleife macht bis er auf eine Leere Zelle stösst bei "Lieferschein" Spalte E (Also von E19 bis erste Leere Zelle in Spalte E)
Vielen Dank 
Sub Test2()
' Test2 Makro
For ZeileNr = 19 To 21
Sheets("Eingabe Daten Prod. Auftrag").Range("B11").Value = _
Sheets("Lieferschein").Range("E" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("C11").Value = _
Sheets("Lieferschein").Range("B" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("D11").Value = _
Sheets("Lieferschein").Range("H" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("E11").Value = _
Sheets("Lieferschein").Range("H15").Value
Sheets("Eingabe Daten Prod. Auftrag").Range("F11").Value = _
Sheets("Lieferschein").Range("C" & ZeileNr).Value
Application.Run _
"Fertigungsplanung_.xlsm!EingabeDatenProdAuftrag_Bestellung"
Next ZeileNr
End Sub

Anzeige
AW: Do until Loop
11.07.2014 09:29:36
Hans
Und die Lösung von Rudi klappt auch nicht richtig
Sub Test()
Dim lRow As Long
lRow = 14
With Sheets("Lieferschein")
Do
.Range("E19").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("B11")
.Range("B19").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("C11")
.Range("H19").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("D11")
.Range("H15").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("E11")
.Range("C19").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("F11")
Application.Run _
"Fertigungsplanung_.xlsm!EingabeDatenProdAuftrag_Bestellung"
lRow = lRow + 1
Loop While .Cells(lRow, 5)  ""
End With
End Sub

Anzeige
AW: Do until Loop
11.07.2014 10:06:08
Michael
Hallo Hans,
ich seh grad, daß sich Rudi vertippt hat:
lrow=19 müßte es heißen, damit die Schleife (Do..while) bei Zeile 19 anfängt;
außerdem ersetzt Du bitte die Zuweisungen bei E19 usw. (alle außer H15) durch Range("E" & lrow), dann müßte Rudis Code klappen.
Verstehst Du das? Range möchte den Spaltenbuchstaben und die Zeilennummer, z.B. eben E19. Wenn die Zeilennummer, z.B. 19, nun in der Variablen lrow (oder bei mir in ZeileNr) steht und Du "addierst" sie mit dem Stringoperator &, dann wird die Zahl "automatisch" in einen String umgewandelt.
"E" & lrow ergibt also schlicht E19 usw.
Ich habe beide Varianten angepaßt, sie tun das Gleiche und funktionieren auch beide bei mir: 
Sub Test_Michael()
Dim ZeileNr As Long
ZeileNr = 19
Do
Sheets("Eingabe Daten Prod. Auftrag").Range("B11").Value = _
Sheets("Lieferschein").Range("E" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("C11").Value = _
Sheets("Lieferschein").Range("B" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("D11").Value = _
Sheets("Lieferschein").Range("H" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("E11").Value = _
Sheets("Lieferschein").Range("H15").Value
Sheets("Eingabe Daten Prod. Auftrag").Range("F11").Value = _
Sheets("Lieferschein").Range("C" & ZeileNr).Value
ZeileNr = ZeileNr + 1
Loop While Sheets("Lieferschein").Range("E" & ZeileNr).Value  ""
End Sub


Sub Test_Rudi()
Dim lRow As Long
lRow = 19
With Sheets("Lieferschein")
Do
.Range("E" & lRow).Copy Sheets("Eingabe Daten Prod. Auftrag").Range("B11")
.Range("B" & lRow).Copy Sheets("Eingabe Daten Prod. Auftrag").Range("C11")
.Range("H" & lRow).Copy Sheets("Eingabe Daten Prod. Auftrag").Range("D11")
.Range("H15").Copy Sheets("Eingabe Daten Prod. Auftrag").Range("E11")
.Range("C" & lRow).Copy Sheets("Eingabe Daten Prod. Auftrag").Range("F11")
'      Application.Run _
'       "Fertigungsplanung_.xlsm!EingabeDatenProdAuftrag_Bestellung"
lRow = lRow + 1
Loop While .Cells(lRow, 5)  ""
End With
End Sub
Happy Exceling,
Michael

Anzeige
Nachtrag
11.07.2014 10:20:40
Michael
Hallo Hans,
ich hab noch eine kleine Änderung vorgenommen.
Anstatt der msgbox kannst Du Dein Makro aufrufen oder ggf. einen Fehler abfragen oder so.
Sub Test2_Michael()
' Mit "kopfgesteuerter Schleife"
' nur für den Fall, daß E19 leer ist - kann das mal sein?
Dim ZeileNr As Long
ZeileNr = 19
While Sheets("Lieferschein").Range("E" & ZeileNr).Value  ""
Sheets("Eingabe Daten Prod. Auftrag").Range("B11").Value = _
Sheets("Lieferschein").Range("E" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("C11").Value = _
Sheets("Lieferschein").Range("B" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("D11").Value = _
Sheets("Lieferschein").Range("H" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("E11").Value = _
Sheets("Lieferschein").Range("H15").Value
Sheets("Eingabe Daten Prod. Auftrag").Range("F11").Value = _
Sheets("Lieferschein").Range("C" & ZeileNr).Value
ZeileNr = ZeileNr + 1
Wend
If ZeileNr > 19 Then MsgBox "Schleife " & ZeileNr - 19 _
Else MsgBox "Schleife nicht ausgeführt"
End Sub
Happy Exceling,
Michael

Anzeige
AW: Nachtrag
11.07.2014 10:26:50
Hans
Vielen Dank Michael
Die Lösung war ja so nah habe mich total Verannt
Es sollte nicht Vorkommen ist es aber auch schon Das E19 leer war
Somit ist es die Perfekte Lösung, Du bist mein Held :-)
Bin halt noch ein Totaler VBA Anfänger, habe mich aber total Verliebt
Viele Grüsse Hans

Verliebt?
11.07.2014 12:18:35
Michael
Na, das freut mich - Programmieren macht schon Spaß, wenn es denn klappt.
Der Rechner macht halt nur das, was man ihm sagt, und nicht das, was man sich denkt. Noch.
In der Ruhe liegt die Kraft.
Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige