Guten Morgen Franz,
ja du hast das richtig verstanden:
1. Schritt: Spazialfilter setzen und rüberkopieren.
Wie könnte ich denn abfangen, sollte es mal keine Daten geben, die den Filterkriterien entsprechen?
2. Schritt: Auch richtig verstanden: Es sollen immer die Werte von Spalte M aus dem Tabellenblatt "Hilfstabelle" in das Tabellenblatt "Hintergrundtabelle" Spalte J kopiert werden (TAG, NIF, MO,...) allerdings ohne Duplikate! Die Schleife soll so dann irgendwann so ablaufen:
also im ersten Durchlauf sollen diese Kriterien gefiltert werden:
S2, C1,
S6, C1,
S7, C1,
S8, C1,
S2,* , C1,=""
dann die Schleife mit dem nächsten gefunden Wert aus Tabellenblatt "Datenzusammenführung" also C2:
S2, C2,
S6, C2,
S7, C2,
S8, C2,
S2,* , C2,=""
und dann C3... bis C8.
Zu deinem Kommentar mit inPlace- filtern: ich hab das nun eher als Vorteil gesehen (das Rüberkopieren der gefilterten Werte), weil ich nachher noch ein paar Formeln an der Seite berechne,... Gut, diese würden sich auch berechnen lassen, wenn man in diese Formeln "Teilergebnis" einarbeitet, ich seh nun aber nicht, dass das nun vorteilhafter wäre...Aber es ist ein Versuch wert!
Ja und das stimmt die Schleife läuft nicht durch, also halt nur für C1 und um ehrlich zu sein ist mir auch schleierhaft, wieso das so ist...
Fazit: in diesem Code funktiniert so einiges nicht, allerdings benötige ich diese Hintergrundtabelle für meinen nächsten Schritt und habe leider auch keine ALternative bereitliegen :( Um ehrlich zu sein, hab ich mir das Ganze auch deutlich leichter vorgestellt!
Hier ist noch einmal ein Code, wo das Untereinanderkopieren funktioniert für die Kriterien S2,C1, und S8,C1, (allerdings sind hier auch jeweils immer 2 Datenzeilen rüberkopiert worden).
Sub su()
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Dim last As Long
Dim lest As Long
Dim lost As Long
Dim list As Long
Dim var As Variant
Dim sar As Variant
Dim tar As Variant
Dim i As Long
Dim j As Long
Dim c As Variant
Dim d As Integer
Dim a As Variant
Set Quelle = Sheets("Hilfstabelle")
Set Ziel = Sheets("Hintergrundtabelle")
last = Sheets("Hilfstabelle").Cells(Rows.Count, 16).End(xlUp).Row
list = Worksheets("Haupttabelle").Cells(Rows.Count, 1).End(xlUp).Row
lost = Worksheets("Datenzusammenführung").Cells(Rows.Count, 7).End(xlUp).Row
'Prozedur: Führe für jedes Cluster aus "Haupttabelle" folgende Prozeduren durch
With Worksheets("Haupttabelle")
For Each c In .Range("A14:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
e = 13
e = e + 1
With Sheets("Hilfstabelle").UsedRange
.Range("A1").Value = "Bautyp"
.Range("A2").Value = "S2"
.Range("B1").Value = "Cluster"
.Range("B2").Value = Sheets("Haupttabelle").Cells(e, 1).Value
.Range("C1").Value = "Zuweisung VT, GT"
.Range("C2").Value = ""
Sheets("Datenzusammenführung").Range("A:S").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=.Range("A1:C2"), _
CopyToRange:=.Range("A4")
.Range(.Cells(5, 13), .Cells(last, 13)).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Hintergrundtabelle").Range("j13"), unique:=True
'Berechnung prozentualer Anteil Planungakal
.Range(.Cells(5, 20), .Cells(last, 20)).FormulaR1C1 = "=COUNTIF(R5C13:R" & last & " _
C13,RC[-7])/COUNTA(R5C13:R" & last & "C13)"
Range(.Cells(5, 21), .Cells(last, 21)).FormulaR1C1 = _
"=VLOOKUP(Hintergrundtabelle!r[8]c[-11],Hilfstabelle!RC[-8]:RC[-1],8)"
.Range(.Cells(5, 21), .Cells(last, 21)).Copy
Sheets("Hintergrundtabelle").Cells(13, 11).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 16)), Cells(Rows.Count, 16).End(xlUp).Row, _
Rows.Count)
.Range("V4").Formula = "=AVERAGE(F5:F" & lngLetzte & ")"
.Range("V5").Formula = "=COUNTIFS(D5:D" & lngLetzte & ",""S2"",G5:G" & lngLetzte & " _
,""" & Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""GT"")"
.Range("V6").Formula = "=COUNTIFS(D5:D" & lngLetzte & ",""S2"",G5:G" & lngLetzte & " _
,""" & Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""VT"")"
.Range("V7").Formula = _
"=IF(ISERROR(AVERAGEIFS(N5:N" & lngLetzte & ",G5:G" & lngLetzte & ",""" & _
Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""GT"",D5:D" & lngLetzte & ",""S2"")),0,(AVERAGEIFS(N5:N" & lngLetzte & ",G5:G" & lngLetzte & ",""" & Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""GT"",D5:D" & lngLetzte & ",""S2"")))"
.Range("V8").Formula = _
"=IF(ISERROR(AVERAGEIFS(N5:N" & lngLetzte & ",G5:G" & lngLetzte & ",""" & _
Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""VT"",D5:D" & lngLetzte & ",""S2"")),0,(AVERAGEIFS(N5:N" & lngLetzte & ",G5:G" & lngLetzte & ",""" & Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""VT"",D5:D" & lngLetzte & ",""S2"")))"
.Range("V9").Formula = _
"=ROUNDUP(((Haupttabelle!B5*Haupttabelle!C5)/V4)*V5,0)"
.Range("V10").Formula = _
"=ROUNDUP(((Haupttabelle!B5*Haupttabelle!C5)/V4)*V6,0)"
.Range("V11").Formula = _
"=ROUNDUP(((Haupttabelle!B5*Haupttabelle!C5)/V4)*(V5*V7+V6*V8),0)"
.Range("V12").Formula = "=COUNTIF(S$5:s$" & lngLetzte & ", ""2"")/COUNTA(S$5:s$" & _
lngLetzte & ")"
.Range("V13").Formula = "=ROUNDUP((Hintergrundtabelle!K13*V11),0)"
.Range("A2").Copy
Sheets("Hintergrundtabelle").Cells(13, 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("V4:V11").Copy
Sheets("Hintergrundtabelle").Cells(13, 2).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Range("V12:V13").Copy
Sheets("Hintergrundtabelle").Cells(13, 12).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End With
Worksheets("Hilfstabelle").Cells.Clear
lest = Sheets("Hintergrundtabelle").Cells(Rows.Count, 10).End(xlUp).Row
With Sheets("Hilfstabelle").UsedRange
.Range("A1").Value = "Bautyp"
.Range("A2").Value = "S8"
.Range("B1").Value = "Cluster"
.Range("B2").Value = Sheets("Haupttabelle").Cells(e, 1).Value
.Range("C1").Value = "Zuweisung VT, GT"
.Range("C2").Value = ""
Sheets("Datenzusammenführung").Range("A:S").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=.Range("A1:C2"), _
CopyToRange:=.Range("A4")
.Range(.Cells(5, 13), .Cells(last, 13)).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Hintergrundtabelle").Cells(lest + 1, 10), unique:=True
'Berechnung prozentualer Anteil Planungakal
last = .Cells(Rows.Count, 16).End(xlUp).Row
.Range(.Cells(5, 20), .Cells(last, 20)).FormulaR1C1 = "=COUNTIF(R5C13:R" & last & "C13, _
RC[-7])/COUNTA(R5C13:R" & last & "C13)"
.Range(.Cells(5, 21), .Cells(last, 21)).FormulaR1C1 = _
"=VLOOKUP(Hintergrundtabelle!r[8]c[-11],Hilfstabelle!RC[-8]:RC[-1],8)"
.Range(.Cells(5, 21), .Cells(last, 21)).Copy
Sheets("Hintergrundtabelle").Cells(13, 11).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 16)), Cells(Rows.Count, 16).End(xlUp).Row, Rows. _
Count)
.Range("V4").Formula = "=AVERAGE(F5:F" & lngLetzte & ")"
.Range("V5").Formula = "=COUNTIFS(D5:D" & lngLetzte & ",""S8"",G5:G" & lngLetzte & ",""" & _
Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""GT"")"
.Range("V6").Formula = "=COUNTIFS(D5:D" & lngLetzte & ",""S8"",G5:G" & lngLetzte & ",""" & _
Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""VT"")"
.Range("V7").Formula = _
"=IF(ISERROR(AVERAGEIFS(N5:N" & lngLetzte & ",G5:G" & lngLetzte & ",""" & Sheets(" _
Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""GT"",D5:D" & lngLetzte & ",""S8"")),0,(AVERAGEIFS(N5:N" & lngLetzte & ",G5:G" & lngLetzte & ",""" & Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""GT"",D5:D" & lngLetzte & ",""S8"")))"
.Range("V8").Formula = _
"=IF(ISERROR(AVERAGEIFS(N5:N" & lngLetzte & ",G5:G" & lngLetzte & ",""" & Sheets(" _
Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""VT"",D5:D" & lngLetzte & ",""S8"")),0,(AVERAGEIFS(N5:N" & lngLetzte & ",G5:G" & lngLetzte & ",""" & Sheets("Haupttabelle").Cells(e, 1).Value & """,L5:L" & lngLetzte & ",""VT"",D5:D" & lngLetzte & ",""S8"")))"
.Range("V9").Formula = _
"=ROUNDUP(((Haupttabelle!B5*Haupttabelle!C5)/V4)*V5,0)"
.Range("V10").Formula = _
"=ROUNDUP(((Haupttabelle!B5*Haupttabelle!C5)/V4)*V6,0)"
.Range("V11").Formula = _
"=ROUNDUP(((Haupttabelle!B5*Haupttabelle!C5)/V4)*(V5*V7+V6*V8),0)"
.Range("V12").Formula = "=COUNTIF(S$5:s$" & lngLetzte & ", ""2"")/COUNTA(S$5:s$" & _
lngLetzte & ")"
.Range("V13").Formula = "=ROUNDUP((Hintergrundtabelle!K13*V11),0)"
Set a = Sheets("Hintergrundtabelle").Cells(lest + 1, 10)
letzte = Worksheets("Hintergrundtabelle").Cells(13, 10).End(xlUp).Row
.Range("A2").Copy
a.Offset(0, -9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Range("V4:V11").Copy
a.Offset(0, -8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
.Range("V12:V13").Copy
a.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks: _
=False, Transpose:=True
Worksheets("Hilfstabelle").Cells.Clear
End With
Next c
End With
End Sub
FÜr Kriterien S6,C1,: Du meintest ja, dass der zu filternde Bereich immer aus 2 Zeilen bestehen muss, aber das macht er ja hier: also immer M und dann die gefiterte Zeile, der Fehler tritt aber erst auf, wenn er dann den gefunden wert unter M kopieren soll. Dh dann ja, dass er auch 2 Datenzeilen brauch oder? Ich würde halt noch wie vor, wenn nur eine Datenzeile übergeben worden ist, diese verdoppeln um den Wert, den ich haben möchte (TAG, NIF, MO,...) rüberkopieren zu können...
Oder?
Viele Grüße, Vigo