Anzeige
Archiv - Navigation
1388to1392
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

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.

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

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")

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 :)

385 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige