Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
980to984
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
980to984
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

2 schleifen

2 schleifen
27.05.2008 10:21:17
Köhler
Hallo,
wie könnte ich diesen Spagetticode verkürzen, bzw. 2 schleifen ineinandergreifen lassen?
For i = 1 To 850
If Sheets("data €").Cells(i, 1) = Sheets("data €").Cells(i, 16) Then
If Sheets("data €").Cells(4, 17).Value = "01/01/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 3)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/02/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 4)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/03/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 5)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/04/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 6)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/05/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 7)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/06/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 8)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/07/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 9)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/08/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 10)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/09/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 11)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/10/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 12)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/11/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 13)
ElseIf Sheets("data €").Cells(4, 17).Value = "01/12/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 14)
Else
Worksheets("data €").Cells(i, 16).Font.ColorIndex = 3
End If
Next i

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2 schleifen
27.05.2008 10:33:40
Peter
Hallo Köhler,
versuch es doch einmal so:
Option Explicit

Public Sub Einfacher()
Dim lZeile  As Long
For lZeile = 1 To 850
If Sheets("data €").Cells(lZeile, 1) = Sheets("data €").Cells(lZeile, 16) Then
Select Case Sheets("data €").Cells(4, 17).Value
Case "01/01/2008"
Worksheets("data €").Cells(lZeile, 17).Copy Destination:= _
Worksheets("data €").Cells(lZeile, 3)
Case "01/02/2008"
Worksheets("data €").Cells(lZeile, 17).Copy Destination:= _
Worksheets("data €").Cells(lZeile, 4)
' usw usw
End Select
End If
Next lZeile
End Sub


Gruß Peter

Anzeige
AW: 2 schleifen
27.05.2008 11:39:01
Köhler
super, select case ist genau die funktion die ich gesucht habe. danke!

AW: 2 schleifen
27.05.2008 10:45:57
Dirk
Hallo!
Probier mal so:
For i = 1 To 850
If Sheets("data €").Cells(i, 1) = Sheets("data €").Cells(i, 16) Then
For j= 1 to 12
If Sheets("data €").Cells(4, 17).Value = "01/" & j &"/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 2+j)
Else
Worksheets("data €").Cells(i, 16).Font.ColorIndex = 3
next j
End If
Next i
Habs nicht ausprobiert, sollte aber so gehen.
Lass' mal hoeren
Gruss
Dirk aus Dubai

Anzeige
AW: 2 schleifen
27.05.2008 10:55:15
Dirk
Hallo nochmal,
kleiner denkfehler nach der Mittagspause, sorry. Hier die Korrektur:
For i = 1 To 850
k=0
If Sheets("data €").Cells(i, 1) = Sheets("data €").Cells(i, 16) Then
For j= 1 to 12
If Sheets("data €").Cells(4, 17).Value = "01/" & j &"/2008" Then
Worksheets("data €").Cells(i, 17).Copy Destination:= _
Worksheets("data €").Cells(i, 2+j)
k=1
j=12
Else
next j
if k=0 then
Worksheets("data €").Cells(i, 16).Font.ColorIndex = 3
end if
End If
Next i
Gruss
Dirk aus Dubai

AW: 2 schleifen
27.05.2008 10:46:25
Peter
Hallo Köhler,
mit zwei Schleifen so:

Public Sub ZweiSchleifen()
Dim lZeile  As Long
Dim iMonat  As Integer
Dim iSpalte As Integer
For lZeile = 1 To 850
If Sheets("data €").Cells(lZeile, 1) = Sheets("data €").Cells(lZeile, 16) Then
For iMonat = 1 To 12
If Sheets("data €").Cells(4, 17).Value = DateSerial(2008, iMonat, 1) Then
Worksheets("data €").Cells(lZeile, 17).Copy Destination:= _
Worksheets("data €").Cells(lZeile, iMonat + 2)
End If
Next iMonat
End If
Next lZeile
End Sub


Gruß Peter

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige