AW: Statistikbereich ...
13.03.2015 11:56:37
Sebastian
Guten Morgen Matthias,
ich freu mich sehr das jetzt das Kopieren in Bezug auf das Datum so gut klappt! Ich habe versucht es in unseren anderen Bsp. einzubauen, dass er es nicht nur für das Teil 3.030.005-002 durchführt, sondern dann für alle anderen Teile so weiter macht:
Option Explicit
Sub schleife()
Dim x&, j&, y&, FirstCell$, LastCell$
Dim Jahr&, Monat&, rng As Range 'Variablen deklarieren
For Each rng In Tabelle1.Range("B2:B14") 'Anpassen
'Ziel-Spalte ermitteln / setzen
Select Case Year(rng)
Case Is = 2012
Jahr = 2 'Spalte 2 - 2012 wird in Spalt 2 geschrieben
Case Is = 2013
Jahr = 4 'Spalte 4 - 2013 wird in Spalt 4 geschrieben
Case Is = 2014
Jahr = 6 'Spalte 6 - 2014 wird in Spalt 6 geschrieben
End Select
'Ziel-Zeile ermitteln / setzen
Select Case Month(rng)
Case Is = 1 'Jan
Monat = 4 'Jan = Zeile 4
Case Is = 2 'Feb
Monat = 5 'Feb = Zeile 5 --- usw...
Case Is = 3 'Mrz
Monat = 6
Case Is = 4 'Apr
Monat = 7
Case Is = 5 'Mai
Monat = 8
Case Is = 6 'Jun
Monat = 9
Case Is = 7 'Jul
Monat = 10
Case Is = 8 'Aug
Monat = 11
Case Is = 9 'Sep
Monat = 12
Case Is = 10 'Okt
Monat = 13
Case Is = 11 'Nov
Monat = 14
Case Is = 12 'Dez
Monat = 15
End Select
Tabelle4.Cells(Monat, Jahr) = rng.Offset(, 1).Value
Tabelle1.Select 'Starttabelle
Range("Empfohlen").ClearContents 'Zielbereich leeren
For j = 1 To Range("J1").Value 'Max-TeileNr. aus Zelle einlesen
For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(x, 9) = j Then
If FirstCell = "" Then FirstCell = Cells(x, 1).Address
LastCell = Cells(x, 1).Address
End If
Next
Range(FirstCell & ":" & LastCell).Select 'zur Demo
Tabelle4.Range("Statistik").ClearContents 'Zielbereich leeren
For y = 1 To Selection.Count
Tabelle4.Range("Statistik")(y) = Selection(y).Offset(, 2).Value
Tabelle4.Range("I17") = Selection(y).Offset(, 4).Value
Next
Selection(y).Offset(-1, 11) = Tabelle4.Range("K16").Value
Tabelle4.Select
MsgBox "Bereich:" & vbLf & FirstCell & ":" & LastCell, vbInformation, Selection(1).Value
Tabelle1.Select 'zur Kontrolle
FirstCell = ""
Tabelle4.Range("Statistik").ClearContents 'Zielbereich leeren
Next
Cells(1, 1).Select
Next
End
Sub
Es gibt mir die Werte aber fehlerhaft aus. Alle Bestellmengen werden nun nur noch in 2012 bei " _
SB" kopiert. Und ich habe eine Endlosschleife erhalten.
Anbei mal die geänderte Datei
