Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1364to1368
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
Inhaltsverzeichnis

Zeile verdoppeln, wenn nur 1 mal vorhanden

Zeile verdoppeln, wenn nur 1 mal vorhanden
12.06.2014 15:14:42
Vigo
Hallo zusammen!
Ich möchte eine Fehlermeldung folgendermaßen umgehen:
Der Code soll prüfen wie viele belegte Zeilen es ab Zeile 5 gibt.
Wenn es nur eine gibt, dann soll sie verdoppelt werden (Copy in Zeile 6) und weitere Funktionen ausführen...(hier nur angedeutet)
Wenn es keine belegte Zeile gibt, dann soll er nichts weiter tun...
Ich hab mich schon probiert:

Option Explicit
Sub Makro2()
Dim izeilenanzahl As Long
With Worksheets("Hilfstabelle")
izeilenanzahl = Cells(.UsedRange.Rows.Count, 1)
If izeilenanzahl = 1 Then
.Rows(5).Copy Destination:=.Rows(6)
[...]                                   'weiter Funktionen
ElseIf izeilenanzahl = 0 Then
End If
End With
End Sub

Läuft fehlerfrei ab, allerdings verdopplet er nicht! :(
Kann mir jemand dabei helfen?
Viele Grüße, Vigo

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeile verdoppeln, wenn nur 1 mal vorhanden
12.06.2014 15:58:48
Daniel
Hi
izeilenanzahl = Cells(.UsedRange.Rows.Count, 1)

mit diesem Code fragst du ab, welcher Wert in der Zelle steht, die auf dem aktiven Blatt liegt in der Spalte A in der Zeile, die der Anzahl der genutzen Zeilen im Blatt "Hilfstabelle" entspricht.
Gruß Daniel

AW: Zeile verdoppeln, wenn nur 1 mal vorhanden
12.06.2014 16:02:00
fcs
Hallo Vigo,
etwas in der folgenden Richtung.
Die Benutzung von UsedRange kann durch leere formatierte Zellen zu unerwarteten/falschen Ergebnissen führen.
Gruß
Franz
Sub Makro2()
Dim izeilenanzahl As Long
Dim rngZelle As Range
With Worksheets("Hilfstabelle").Cells
Set rngZelle = .Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
'Tabelle ist leer
MsgBox "Keine daten in Hilfstabelle"
Else
izeilenanzahl = rngZelle.Row
Select Case izeilenanzahl
Case Is = 7
MsgBox "mehr als 6 Zeilen"
End Select
End If
End With
End Sub

Anzeige
""
12.06.2014 20:34:48
Vigo
Hallo zusammen!
Vielen Dank für eure Antworten.
Leider funktioniert das Ganze noch nicht so wie gewünscht.
Ich hab euch mal eine Mappe hochgeladen. Wenn ihr das Modul "Hintergrundtabellensetup" ausführt, dann seht ihr den Fehler, den ich umgehe möchte. Der Code läuft wie gewünscht, wenn mindestens 2 Zeilen in das Tabellenblatt "Hilfstabelle" kopiert werden. Ich weiß den Code leider nicht abzuwandeln, dass er ohne diese Krücke funktioniert. Ziel ist es eine automatisch generierte Tabelle im Tabellenblatt "Hintergrundtabelle" aufzubauen. Nach bestimmten Filterkriterien werden Daten vom Tabellenblatt "Datenzusammenführung" ins Tabellenblatt "Hilfstabelle" kopiert. Der Fehler tritt auf, wenn aus den gefilterten Daten Spalte M ohne Duplikate in das Tabellenblatt "Hintergrundtabelle" kopiert werden soll.
Für die entgültige Tabelle wird der Code noch mit weiteren Abfragen erweitert (Kriterien: S2, C1, ; S8,C1,; S2,C2, ; ...). Ich hoffe, dass ich das Problem habe ausführlich rüberbringen können, wenn nicht einfach noch mal nachfragen...
Ich hab versucht Franz' Code einzubauen, aber leider hat das Duplizieren der einen Zeile nicht geklappt.
Könnt ihr mir bitte noch einmal helfen und mir einen Tipp geben wie ich diesen Code zum Laufen bringen kann?
https://www.herber.de/bbs/user/91098.xlsm
Viele Grüße, Vigo

Anzeige
AW: ""
13.06.2014 06:54:27
fcs
Hallo Vigo,
ich hab versucht nachzuvollziehen, was passieren soll.
Der 1. Schritt ist klar. Spezialfilter setzen und Daten aus "Datenzusammenführung" nach "Hilfstabelle" kopieren.
Der 2. Schritt: Der Fehler tritt auf, wenn aus den gefilterten Daten Spalte M ohne Duplikate in das Tabellenblatt "Hintergrundtabelle" kopiert werden soll.
Ein zu filternder Bereich besteht immer mindestens aus 2 Zeilen. Der Zeile mit den Spaltentiteln und mindestens 1 Datenzeile. D.h. er müßte immer in Zeile 4 mit dem EIntrag "M" beginnen.
Was willst du denn hier ereichen?
Was soll dann nach Blatt "Hintergrundtabelle" kopiert werden? Nur Werte wie "NIF", "TAG", "MO", etc. ab er jeweils nur einmal in die Spalte J?
Bei meinen ersten Versuchen in diese Richtung wurden immer alle Zeilen ausgeblendet bzw. keine Werte kopiert.
Nach meiner Einschätzung wird es hier auch Problematisch wenn du die Schleife mit mehreren Werte abarbeitest und der Zielbereich nach unten wandert. Wahrscheinlich muss man hier in Place filtern und die Werte kopieren. Es sei den die Hintergrundtabelle wird auch immer nur für einen Schleifendurchlauf mit Daten befüllt.
Gruß
Franz

Anzeige
AW: ""
13.06.2014 08:34:48
Vigo
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

Anzeige
AW: ""
13.06.2014 12:10:11
fcs
Hallo Vigo,
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...
verschiebe die Zeile
e = 13
vor die Zeile mit For Each c In ...
so wie es jetzt ist holt sich das Makro immer wieder den Wert aus Zeile 14.
Erkennen, ob der 1. Filtervorgang keine Daten liefert.
Hier muss man nach dem Filtern die letzte Zeile im Blatt "Hilfstabelle" ermitteln. Die folgenden Aktionen nur dann ausführen, wenn letzte Zeile &gt=5.
Beim 2. Filtern für Spalte M muss ich nochmals prüfen, ob man das per Spezialfilter hinbekommt. Evtl. ist es einfacher, die Spalte M von Zeile 5 bis zum Ende der Liste abzuarbeiten und jeden vorkommenden Wert einmal in Spalte J der Haupttabelle ab Zeile 13 einzutragen.
Gruß
Franz

Anzeige
AW: ""
14.06.2014 10:45:49
fcs
Hallo Vigo,
ich hab das Makro "su" jetzt angepast und ein wenig aufgeräumt - für alle 4 angesprochenden Tabellenblätter sind jetzt Objektvariablen verwendet.
https://www.herber.de/bbs/user/91111.xlsm
Wichtig für Funktion des Filters in Spalte M:
1. Es muss ein Bereich mit Selektionskriterien angegeben werden (habe E1:E2 dafür festgelegt)
2. In Hintergrunddaten Zelle J12 muss der Spaltentitel aus M4 stehen; hab ich jetzt per Formel gemacht.
Gruß
Franz

AW: ""
14.06.2014 11:24:58
Vigo
Hallo Franz!
Ich wollt mich auch mal wieder an die Arbeit machen! Ich werd mir deinen Vorschlag gleich mal anschauen! Schon mal vielen, vielen Dank, dass du dir die Mühe gemacht hast! Ich werd mich später noch einmal melden!
Viele Grüße, Vigo

Anzeige
AW: ""
14.06.2014 19:27:03
Vigo
Hallo zusammen!
@ Franz: Ja, ich schätze, so sieht wohl ein bereinigter Code aus^^ :)
Vielen Dank für deine Mühe!!!
Dein Code macht genau das, was er eig soll, bis auf die Tatsache, dass er die zu filterden Daten im Tabellenblatt "Hintergrundtabelle" ab Spalte J12 immer wieder überschreibt.
Ich hätte sie gerne untereinader kopiert.
Ich versuche gerade die ganze Zeit mich an diesem Beispiel zu orientieren:
http://www.ms-office-forum.net/forum/archive/index.php?t-272948.html
Um zu erreichen, dass die gefilterten Daten in Tabellenblatt "Hintergrundtabelle" ab Spalte J12 jeweils immer untereinander kopiert werden.
Nach dem oben kopierten Link muss man nachdem die Daten kopiert wurden, die Variable zur Ermittlung der letzten Zeile einer Spalte um eins hochsetzen. Hab den Code mal kopiert und unbenannt (su2). Beim ersten mal Ausführen macht er das nur für C1 ab Zelle(1,10) und wirft einen Fehler aus. Wenn ich ihn dann wieder ausführe, dann wird das Ergebnis für C8 ausgegeben in Zelle (2,10) ohne Fehler, obwohl ich ja angebenen habe: CopyToRange:=wksHinter.Range(Cells(12, 10), Cells(lest, 10)). Der Code wird also weder ab Zelle (12,10) ausgeführt, noch werden die Daten untereinander kopiert. Hast du oder jemand anderes vielleicht eine Idee, was ich abändern muss?
Viele Grüße, Vigo
Option Explicit
Sub su2()
Dim wksHilf As Worksheet
Dim wksHinter As Worksheet
Dim wksDaten As Worksheet
Dim wksHaupt 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 izeilenanzahl As Long
Dim e As Long
Set wksHilf = Sheets("Hilfstabelle")
Set wksHinter = Sheets("Hintergrundtabelle")
Set wksDaten = Sheets("Datenzusammenführung")
Set wksHaupt = Sheets("Haupttabelle")
With wksHilf
last = .Cells(.Rows.Count, 16).End(xlUp).Row
End With
With wksHinter
lest = .Cells(.Rows.Count, 10).End(xlUp).Row
End With
With wksHaupt
list = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With wksDaten
lost = .Cells(.Rows.Count, 7).End(xlUp).Row
End With
'Prozedur: Führe für jedes Cluster aus "Haupttabelle" folgende Prozeduren durch
With wksHaupt
e = 13
For Each c In .Range("A14:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
e = e + 1
With wksHilf
'Kriterienbereich für 1. Filter Spalten A bis S in Datenzusammenführung
.Range("A1").Value = "D"
.Range("A2").Value = "S6"
.Range("B1").Value = "G"
.Range("B2").Value = wksHaupt.Cells(e, 1).Value
.Range("C1").Value = "L"
.Range("C2").Value = ""
'Kriterienbereich für 2. Filter in Spalte M
.Range("E1").Value = "M"
.Range("E2").ClearContents
'Filter in Datenzusammenführung setzen und Daten in Hilfstabelle kopieren
wksDaten.Range("A:S").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=.Range("A1:C2"), _
CopyToRange:=.Range("A10:S10")
'letzte Zeile mit Daten in Hilfstabelle
last = .Cells(Rows.Count, 13).End(xlUp).Row
If last 

Anzeige
AW: ""
14.06.2014 19:42:27
Vigo
Ich habs geschafft! Also fasst:
Option Explicit
Sub su2()
Dim wksHilf As Worksheet
Dim wksHinter As Worksheet
Dim wksDaten As Worksheet
Dim wksHaupt 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 izeilenanzahl As Long
Dim e As Long
Set wksHilf = Sheets("Hilfstabelle")
Set wksHinter = Sheets("Hintergrundtabelle")
Set wksDaten = Sheets("Datenzusammenführung")
Set wksHaupt = Sheets("Haupttabelle")
With wksHilf
last = .Cells(.Rows.Count, 16).End(xlUp).Row
End With
'With wksHinter
lest = Sheets("Hintergrundtabelle").Cells(Rows.Count, 10).End(xlUp).Row
'End With
With wksHaupt
list = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With wksDaten
lost = .Cells(.Rows.Count, 7).End(xlUp).Row
End With
'Prozedur: Führe für jedes Cluster aus "Haupttabelle" folgende Prozeduren durch
With wksHaupt
e = 13
For Each c In .Range("A14:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
e = e + 1
With wksHilf
'Kriterienbereich für 1. Filter Spalten A bis S in Datenzusammenführung
.Range("A1").Value = "D"
.Range("A2").Value = "S6"
.Range("B1").Value = "G"
.Range("B2").Value = wksHaupt.Cells(e, 1).Value
.Range("C1").Value = "L"
.Range("C2").Value = ""
'Kriterienbereich für 2. Filter in Spalte M
.Range("E1").Value = "M"
.Range("E2").ClearContents
'Filter in Datenzusammenführung setzen und Daten in Hilfstabelle kopieren
wksDaten.Range("A:S").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=.Range("A1:C2"), _
CopyToRange:=.Range("A10:S10")
'letzte Zeile mit Daten in Hilfstabelle
last = .Cells(Rows.Count, 13).End(xlUp).Row
If last CopyToRange:=Sheets("Hintergrundtabelle").Cells(lest, 10), unique:= _
True
Application.CutCopyMode = False
End If
End With
'Worksheets("Hilfstabelle").Cells.Clear
lest = Sheets("Hintergrundtabelle").Cells(.Rows.Count, 10).End(xlUp).Row + 1
Next c
End With
End Sub
Das Problem mit dem Untereinaderkopieren ist somit geschafft! (Abänderungen im Code dicker hinterlegt) Wie krieg ich das noch hin, dass er erst ab Zelle (12,10) damit anfängt?
Viele Grüße, Vigo

Anzeige
AW: ""
14.06.2014 21:13:27
fcs
Hallo Vigo,
ich hab dir die Anpassung in meinen Code von gestern eingebaut. Formeln und Kopieren von Ergebnissen werden übersprungen.
https://www.herber.de/bbs/user/91120.txt
Um eine Startzeile vorzugeben, muss du "nur" die ermittelte Zeile prüfen und falls erforderlich auf einen Mindestwert setzen.
Falls der mitkopierte Spaltentitel in der Zieltabelle nicht stehen bleiben soll, dann muss diese Zelle nach dem Kopieren der gefilterten Daten wieder gelöscht werden.
Gruß
Franz

AW: ""
16.06.2014 07:39:46
Vigo
Hallo Franz!
Vielen, vielen Dank für deine Hilfe und deine Mühen!!!
Ich bin dadurch ein ganzes Stück weitergekommen!
Viele Grüße, Vigo
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige