Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: VSB - Zeile auslesen, wenn Bedingung erfüllt

VSB - Zeile auslesen, wenn Bedingung erfüllt
24.10.2014 14:33:36
loki
Hallo,
leider bin ich nicht sonderlich gut bewandt in Visual Basic, doch glaube ich genau dort die Lösung meines derzeitigen Problems zu finden.
Ausgangssituation:
Ich habe zwei Tabellen.
Tabelle 1 = Quelle
Tabelle 2 = Ziel
In Tabelle 1 stehen jeweils in jeder Zeile in den Spalten A bis P verschiedene Zahlen. Diese möchte ich gerne 1:1 in Tabelle 2 übertragen, sofern H 0 ist. Wenn H = 0 ist, soll automatisch die nächste Zeile übertragen werden, die ebenfalls wieder der Bedingung H 0 unterliegt.

Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VSB - Zeile auslesen, wenn Bedingung erfüllt
24.10.2014 14:52:19
yummi
Hallo loki,

sub kopiereDaten
dim lQ as long
dim i as long
dim j as long
lQ = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
j = 1
for i = 1 to lQ
if Sheets("Tabelle1").Cells(i,8).value  0 then
Sheets("Tabelle1").range("A" & i & ":P" & i).copy Sheets("Tabelle1").range("A" & j & " _
:P" & j)
j = j+1
end if
next i
end sub
ungetestet sollte das liefern was du willst
Gruß
yummi

Anzeige
Variante mit dem Spezialfilter
24.10.2014 14:57:57
Tino
Hallo,
hier mal eine Variante mit dem Spezialfilter.
(Überschriften werden mit übernommen!)
Sub Beispiel()
Dim rng  As Range, rngHelp As Range
Dim QuellSh As Worksheet, ZielSh As Worksheet
Dim lngRowMax&, lngColMax&
'Tabelle Quelle, evtl. anpassen
Set QuellSh = Tabelle1
'Tabelle Ziel, evtl. anpassen
Set ZielSh = Tabelle2
'Datenbereich bestimmen
'Ab A1 (=Überschrift)
'bis letzte Zeile in Spalte H
'bis letzte Spalte in Zeile 1
With QuellSh
lngRowMax = .Cells(.Rows.Count, 8).End(xlUp).Row
lngColMax = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rng = .Range("A1", .Cells(lngRowMax, lngColMax))
'Hilfszelle neben Datenbereich
Set rngHelp = .Cells(1, lngColMax + 1).Resize(2, 1)
End With
'Spezialfilter mit Formel in Hilfsspalte
With rng
'Formel in zweite Zelle HilfsBereich "=$H80"
rngHelp.Cells(2, 1).FormulaR1C1 = "=RC80"
'Spezialfilter anwenden
.AdvancedFilter xlFilterCopy, rngHelp, ZielSh.Range("A1")
End With
'Hilfszelle löschen
rngHelp.Clear
End Sub
Gruß Tino

Anzeige
AW: Variante mit dem Spezialfilter
24.10.2014 15:15:47
loki
Hallo Tino,
vielen dank vorab schon mal für deine Hilfe.
Leider erhalte ich einen Laufzeitfehler '1004': Fehlender oder ungültiger Feldname im Zielbereich.
Es scheint hier laut Debugger an folgender Zeile zu liegen:
.AdvancedFilter xlFilterCopy, rngHelp, ZielSh.Range("A1")

Anzeige
AW: Variante mit dem Spezialfilter
24.10.2014 15:33:44
Tino
Hallo,
dann sind die Überschriften im Ziel anders als die in der Quelle!
Gruß Tino

AW: Variante mit dem Spezialfilter
24.10.2014 15:57:36
loki
Ich hab die Überschriften gerade mit Copy & Paste von der Quelle zum Ziel kopiert und ich erhalte weiterhin den Fehler. Sehr seltsam...

AW: Variante mit dem Spezialfilter
24.10.2014 16:11:05
Tino
Hallo,
ok. dann machen wir es mal so, der Code schreibt die Überschriften.
Sub Beispiel()
Dim rng  As Range, rngHelp As Range
Dim QuellSh As Worksheet, ZielSh As Worksheet
Dim lngRowMax&, lngColMax&
'Tabelle Quelle, evtl. anpassen
Set QuellSh = Tabelle1
'Tabelle Ziel, evtl. anpassen
Set ZielSh = Tabelle2
'Datenbereich bestimmen
'Ab A1 (=Überschrift)
'bis letzte Zeile in Spalte H
'bis letzte Spalte in Zeile 1
With QuellSh
lngRowMax = .Cells(.Rows.Count, 8).End(xlUp).Row
lngColMax = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rng = .Range("A1", .Cells(lngRowMax, lngColMax))
'Hilfszelle neben Datenbereich
Set rngHelp = .Cells(1, lngColMax + 1).Resize(2, 1)
End With
'Spezialfilter mit Formel in Hilfsspalte
With rng
'Formel in zweite Zelle HilfsBereich "=$H80"
rngHelp.Cells(2, 1).FormulaR1C1 = "=RC80"
'Spezialfilter anwenden
ZielSh.Range("A1").Resize(, rng.Columns.Count).Value = rng.Rows(1).Value
.AdvancedFilter xlFilterCopy, rngHelp, ZielSh.Range("A1").Resize(, rng.Columns.Count)
End With
'Hilfszelle löschen
rngHelp.Clear
End Sub

Gruß Tino

Anzeige
AW: Variante mit dem Spezialfilter
24.10.2014 16:58:04
loki
Funktioniert jetzt! Vielen Dank :)
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige