Schleife für Werteabfrage

[Collan]

Hallo zusammen,

Ich habe bei meiner Excel Tabelle folgendes Problem.

Auf dem Tabellenblatt "Start" werden Sachnummern in dem Bereich B13:B38 eingegeben. Daraufhin zieht es sich aus einem weiteren Blatt "MG" Informationen zu der eingegebenen Sachnummer.
Mit einem Makro habe ich einen Berechnungsschritt aufgezeichnet, welcher mir dann von einem Arbeitblatt "Auswertung" berechnete Werte zurück auf das "Start" Blatt ausgibt.

Meine Frage an euch ist....
Wie kann ich eine Schleife in das Makro einbinden, welches die Liste der B13:B38 abgeht und dann mit der Berechnung aufhört wenn keine Werte mehr drinstehen. Wenn Beispielsweise 10 Werte untereinander stehen, das er automatisch in der 11 Zeile mit der Berechnung stoppt.
Da ich ein totaler Anfänger mit VBA bin wäre ich um einen kleinen Beispielcode sehr dankbar.

Mein bisheriges Makro sieht so aus:

Code:

Range("B13").Select

   Selection.Copy
    Sheets("L-1").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 Range("W216,Z216,AC216,AF216,AI216,AL216,AO216,AR216,AU216,AX216,BA216,BD216,BG216,BJ216,BM216,BP216,BS216,BV216,BY216,CB216,CE216,CH216,CK216,CN216").Select
    Range("CN216").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Auswertung").Select
    Range("B9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("L-1").Select
    Range("X216,AA216,AD216,AG216,AJ216,AM216,AP216,AS216,AV216,AY216,BB216,BE216,BH216,BK216,BN216,BQ216,BT216,BW216,BZ216,CC216,CF216,CI216,CL216,CO216").Select
    Range("CO216").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Auswertung").Select
    Range("B10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Viele Grüße Collan

[Rabe]

Hi,

Wie kann ich eine Schleife in das Makro einbinden, welches die Liste der B13:B38 abgeht und dann mit der Berechnung aufhört wenn keine Werte mehr drinstehen. Wenn Beispielsweise 10 Werte untereinander stehen, das er automatisch in der 11 Zeile mit der Berechnung stoppt.

so?

   Dim loLetzte As Long
  Dim i As Long
  ' 
  loLetzte = Sheets("Auswertung").Cells(Rows.Count, 2).End(xlUp).Row     'letzte belegte Zelle in B (2) 
  For i = 13 To loLetzte
     'dein Code 
  Next i

Dein seitheriger Codeschnipsel kann so verkürzt werden:

   Range("B13").Copy
   Sheets("L-1").Range("E2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   '   Range("CN216").Activate 
   Application.CutCopyMode = False
   Range("W216,Z216,AC216,AF216,AI216,AL216,AO216,AR216,AU216,AX216,BA216,BD216,BG216,BJ216,BM216,BP216,BS216,BV216,BY216,CB216,CE216,CH216,CK216,CN216").Copy
   Sheets("Auswertung").Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   '   Range("CO216").Activate 
   Application.CutCopyMode = False
   Sheets("L-1").Range("X216,AA216,AD216,AG216,AJ216,AM216,AP216,AS216,AV216,AY216,BB216,BE216,BH216,BK216,BN216,BQ216,BT216,BW216,BZ216,CC216,CF216,CI216,CL216,CO216").Copy
   Sheets("Auswertung").Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

[Collan]

Vielen dank für die Schleife.
Diese Funktioniert jetzt bei mir.. nur daraus hat sich ein neues Problem Ermittelt.

Die Werte die er dann wieder ausspuckt müssen ja in einzelne Zeilen abgelegt werden welche 6 Zeilen Auseinander sind.
Die Liegen bei Auswertung. 1 Eintrag wird in B9 eingefügt, 2. Eintrag in B15, 3. Eintrag in B21 usw..

kann man das in den Code mit einbauen?

Viele Grüße
Collan

[Steffl]

Hallo,

das geht mit step

Code:

For i = 9 To loLetzte Step 6

     'dein Code

  Next i

[Collan]

Vielen dank für den Hinweis.

nur ich bin echt nicht fit was das zusammenfügen angeht.
kann mir bitte einer helfen und sagen wo ich den Fehler habe, das es nicht sauber durchläuft?

Code:

Sub Berechnung()

'
'

   Dim loLetzte As Long
   Dim i As Long
   Dim u As Long
   Dim v As Long
   
 loLetzte = Sheets("Start").Cells(Rows.Count, 2).End(xlUp).Row
' letzte belegte Zelle in B (2)

 For u = 13 To loLetzte
   Range("B13").Copy
   Sheets("Lieferant 1").Range("E2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   'Range("CN216").Activate
   Application.CutCopyMode = False
   Range("W216,Z216,AC216,AF216,AI216,AL216,AO216,AR216,AU216,AX216,BA216,BD216,BG216,BJ216,BM216,BP216,BS216,BV216,BY216,CB216,CE216,CH216,CK216,CN216").Copy
 
       For i = 9 To loLetzte Step 6
       Sheets("Auswertung").Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       'Range("CO216").Activate
       Application.CutCopyMode = False
       Sheets("Lieferant 1").Range("X216,AA216,AD216,AG216,AJ216,AM216,AP216,AS216,AV216,AY216,BB216,BE216,BH216,BK216,BN216,BQ216,BT216,BW216,BZ216,CC216,CF216,CI216,CL216,CO216").Copy
           
           For v = 10 To leLetzte Step 6
           Sheets("Auswertung").Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
       Next v
   Next i
  Next u
 
End Sub

[Rabe]

Hi,

nur ich bin echt nicht fit was das zusammenfügen angeht.
kann mir bitte einer helfen und sagen wo ich den Fehler habe, das es nicht sauber durchläuft?

wo verwendest Du in Deinem Code die Lauf-Variablen u, v und i? Eine Schleife ist dazu da, daß eine in einem Code verwendete Variable sich innerhalb eines Bereiches ändert und damit andere Zellen angesprochen werden können.

Statt
Range("B13").Copy
sollte es wohl heißen
Range("B" & u).Copy

analog auch bei den anderen Schleifen.

[Collan]

Super vielen dank habe es hinbekommen :)

Gruß Collan