Microsoft Excel

Herbers Excel/VBA-Archiv

VSB - Zeile auslesen, wenn Bedingung erfüllt

Betrifft: VSB - Zeile auslesen, wenn Bedingung erfüllt von: loki
Geschrieben am: 24.10.2014 14:33:36

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.

  

Betrifft: AW: VSB - Zeile auslesen, wenn Bedingung erfüllt von: yummi
Geschrieben am: 24.10.2014 14:52:19

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


  

Betrifft: Variante mit dem Spezialfilter von: Tino
Geschrieben am: 24.10.2014 14:57:57

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 "=$H8<>0"
    rngHelp.Cells(2, 1).FormulaR1C1 = "=RC8<>0"
    'Spezialfilter anwenden
    .AdvancedFilter xlFilterCopy, rngHelp, ZielSh.Range("A1")
End With

'Hilfszelle löschen
rngHelp.Clear
End Sub
Gruß Tino


  

Betrifft: AW: Variante mit dem Spezialfilter von: loki
Geschrieben am: 24.10.2014 15:15:47

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


  

Betrifft: AW: Variante mit dem Spezialfilter von: Tino
Geschrieben am: 24.10.2014 15:33:44

Hallo,
dann sind die Überschriften im Ziel anders als die in der Quelle!

Gruß Tino


  

Betrifft: AW: Variante mit dem Spezialfilter von: loki
Geschrieben am: 24.10.2014 15:57:36

Ich hab die Überschriften gerade mit Copy & Paste von der Quelle zum Ziel kopiert und ich erhalte weiterhin den Fehler. Sehr seltsam...


  

Betrifft: AW: Variante mit dem Spezialfilter von: Tino
Geschrieben am: 24.10.2014 16:11:05

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 "=$H8<>0"
    rngHelp.Cells(2, 1).FormulaR1C1 = "=RC8<>0"
    '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


  

Betrifft: AW: Variante mit dem Spezialfilter von: loki
Geschrieben am: 24.10.2014 16:58:04

Funktioniert jetzt! Vielen Dank :)


 

Beiträge aus den Excel-Beispielen zum Thema "VSB - Zeile auslesen, wenn Bedingung erfüllt"