Gefilterte Daten in Array schreiben

[Lutz Fricke]

Hallo wertes Forum,

ich hätte da mal wieder ein Problem und weiß nicht warum...

Per VBA filtere ich in der angehängten Datei Daten und schreibe die gefilterten Daten in ein Array.
Das dachte ich jedenfalls.


  Beispiel Filterdaten in Array.xlsm (Größe: 20,96 KB / Downloads: 16)

Aus irgendwelchen Gründen schreibt es aber nur den Bereich bis zur ersten ausgefilterten Zeile ins Array.
Warum, wo ist der Fehler?

Ich habe schon diverse Foren durchsucht und finde dort immer meine Lösung...

Vielen Dank,
Lutz

[Egon12]

Hallo Lutz,

wenn ich es richtig verstanden habe, wäre es dann so:

Code:

Private Sub B_Daten_Einlesen()
    Dim wksQuelle As Worksheet
    Dim Rng As Range, ft As Range
    Dim i&, j&, r&
    Dim arrProdukte()
    Set wksQuelle = Sheets("Rohstoffe_1")
    With wksQuelle
        .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4)).AutoFilter Field:=4, Criteria1:="X"
        Set Rng = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 3))
        ReDim arrProdukte(1 To Rng.SpecialCells(xlCellTypeVisible).CountLarge / 3, 1 To Rng.Columns.Count)
        For Each ft In Rng.SpecialCells(xlCellTypeVisible).Areas
            For r = 1 To ft.Rows.Count
                i = i + 1
                For j = 1 To Rng.Columns.Count
                    arrProdukte(i, j) = ft.Cells(r, j).Value
                Next j
            Next r
        Next ft
        .ShowAllData
    End With
    wksQuelle.Cells(2, 8).Resize(i, UBound(arrProdukte, 2)) = arrProdukte
End Sub

Gruß Uwe

---

Zur Ergänzung,

das ist erst mal nur die rein funktionale Korrektur um das Array mit den gefilterten Werten zu füllen. Es geht natürlich noch kompakter zu bauen. Da mir grad die Zeit fehlt (gehe erst mal anderen Verpflichtungen nach) schau ich gegen 22:00 Uhr noch mal rein.

Gruß Uwe

[slowboarder]

Hi
über die Zuweisung kannst du nur rechteckige und lückenlos zusammenhängende Zellbereiche in ein Array überführen.
das zusammenführen der einzelnen Teile zu einem einzigen ist hier nicht implementiert.

wenn man versucht, einen aus mehreren Teilbereichen (im VBA-Fachsprech "Area" genannt) zusammengesetzen Zellbereich in Array zu überführen, wird immer nur der erste Block verwendet. 
Warum? Weil die Jungs bei Microsoft das so programmiert haben.

Wie kannst du das Lösen?
wenn du, wie im Beispiel gezeigt, nur Werte übertragen willst, dann kannst du das Array weglassen und die Werte mit Copy + PasteSpecial übertragen.

Code:

.Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 3)).SpecialCells(xlCellTypeVisible).copy
.Cells(2, 8).PasteSpecial xlpastevalues

Wenn du die Werte in ein Array übernehmen willst, weil du mit dem Array noch anders weiter arbeiten möchtest, dann musst du dir da einen Workaround programmieren.

dazu gibt es mehrere Möglichkeiten.
a) die Werte mit Copy-Paste erstmal an eine freie Stelle übertragen und von dort ins Array einlesen
b) die Werte vorher so sortieren, dass alle gefilterten Werte einen lückenlos zusammenhängenden Zellblock bilden
c) in VBA die Funktion FILTER verwenden (sofern in der jeweiligen Excelversion vorhanden). Allerdings muss man die über EVALUATE ausführen, weil sie eine Matrixoperation enthält, die VBA so direkt nicht ausführen kann:

Code:

arrProdukte = Evaluate("=FILTER(Rohstoffe_1!A:C,Rohstoffe_1!D:D=""x"")")

Gruß Daniel

[Egon12]

Hallo Lutz,

mal abgesehen, dass es mit Copy/Paste kürzer ist, hier noch diese Prozedur auf das nötigste gestutzt.

Code:

Private Sub B_Daten_Einlesen()
    Dim arrProdukte(), Rng As Range, ft As Range, i&, j&, k&
    With Tabelle21
        .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4)).AutoFilter Field:=4, Criteria1:="X"
        Set Rng = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 3))
        ReDim arrProdukte(1 To Rng.SpecialCells(xlCellTypeVisible).CountLarge / 3, 1 To Rng.Columns.Count)
        For Each ft In Rng.SpecialCells(xlCellTypeVisible).Areas
            For i = 1 To ft.Rows.Count
                k = k + 1
                For j = 1 To Rng.Columns.Count
                    arrProdukte(k, j) = ft.Cells(i, j).Value
                Next j
            Next i
        Next ft
        .ShowAllData
        .Cells(2, 8).Resize(k, UBound(arrProdukte, 2)) = arrProdukte
    End With
End Sub

Option Base 1 braucht es so nicht, da arrProdukte via ReDim arrProdukte(1 To Rng.SpecialCells(xlCellTypeVisible).CountLarge / 3, 1 To Rng.Columns.Count) passend dimensioniert wird.
Ebenso wäre wie Daniel geschrieben hat =FIILTER() ein effizienterer Weg. Aber da braucht es mindestens O2021.

Gruß Uwe

[Lutz Fricke]

Hallo Uwe, hallo Daniel,

vielen Dank für Eure schnelle und ausführliche Hilfe.
Aber da frage ich mich doch, was diese blöde Google-KI wirklich kann...

Dann werde ich wohl sortieren, filtern und wieder zurücksortieren.

@Uwe, noch ne Fragen zu Deinem Code:

• Warum nimmst Du .CountLarge/3? Müsste die 3 dann nicht Rng.Columns.Count sein?
  

Vielen Dank,
Lutz

[Egon12]

Hallo Lutz,

das kann nur, wenn es nur ein Area gibt, funktionieren. Gut, wenn in der Ausgabe nach unten alles frei ist kann man einfach pauschal die Dimension des Arrays entsprechend der Größe der ungefilterten Tabelle vordimensionieren und ausgeben. Oder, man setzt wie ich es schon in Resize gezeigt habe die Zeilendimension mit k. Dann wird auch nur bis dahin zurückgeschrieben.

Wie auch immer. Eine weitere Möglichkeit ist der erweiterte Filter (AdvancedFilter)
Der ist auch schön kurz und knackig. Aber das war ja nicht dein Plan.

Ja ja die KI Sachen. In Sachen VBA ist das zumindest derzeit wohl nur zur Orientierung geeignet.

Vielleicht noch ein paar Anmerkungen zum Thema Evaluate("=FILTER()")und Array.

Man muss hier zwei Fälle behandeln:
- Mehr als ein Treffer braucht man nicht zu behandeln.
- 1 Treffer Array muss gedreht werden.
- Kein Treffer muss fehlerbehandelt werden. Das kann je nach Situation einfach bis speziell sein.

Gruß Uwe

[Andreas Killer]

Aber da frage ich mich doch, was diese blöde Google-KI wirklich kann...

Dann werde ich wohl sortieren, filtern und wieder zurücksortieren.

Eine KI lernt nur das was alle Welt ihr vorgemacht haben.

Und wenn nun alle Welt zum Großteil irgendeinen Blödsinn gemacht hat, dann gibt es keine Intelligenz in der KI die 95% des Schrott aussortiert und Dir die 5% sinnvollen Code gibt.

99% aller User z.B. nehmen immer einen Filter (welcher Art auch immer) um die Zeilen mit dem "X" einzulesen, dabei ist das a...langsam. 

Viel schneller ist es einfach alle Daten in ein Array zu lesen, einmal alle Zeilen zu identifizieren die man braucht und diese in ein 2tes Array zu kopieren. Klar ist der Code für sowas etwas länger... und an der Stelle wollen die meisten das nicht.

Für viele Fälle bietet sich hier auch das Scripting.Dictionary an... wenn man wirklich viele Daten hat.

Andreas.

[schauan]

... Du kannst auch ohne Schleife im Code was erreichen, im Prinzip:

Nur Abba
Evaluate("FILTER(A1:C7, A1:A7<> ""Abba"")")

Ohne Abba
Evaluate("FILTER(A1:C7, NOT(ISNUMBER(SEARCH(""Abba"", A1:A7))))")



und ggf. auch SORT einbauen oder was auch immer ...

---

... hab grade gesehen, das stand bei Daniel ja schon unten dabei ...

[Egon12]

@ Andreas,
 
für ein durchschnittlich zu filterndes Datenaufkommen ist es wohl so ziemlich egal wie man das macht. Wenn es aber um richtig große Sachen geht, wäre für mich in jeden Fall Recordset das Mittel der Wahl.
Da kommt auch kein Dictionary in Sachen Latenz dagegen an.
 
Ansonsten stimme ich dir natürlich zu. Ich selbst baue sowas immer via Speicher und wurste nicht durchs Tabellenblatt. Aber danach war ja von TO nicht gefragt worden.
 
Gruß Uwe

[snb]

Dazu hat MS advancedfilter erfunden:

in VBA

Code:

Sub M_snb()
  [H1:J1] = [A1:C1].Value
  [M1:M2] = [transpose({"Exklusiv","x"})]
  Cells(1).CurrentRegion.AdvancedFilter 2, [M1:M2], [H1:J1]
End Sub

Geht auch einfach händisch: Tab Data ; Advanced