Gefilterte Daten in Array schreiben

[Lutz Fricke]

Jetzt nicht streiten wegen mir  .

Es sind nicht sooo viele Daten und, ob ich hier ne Sekunde spare oder nicht, ist hier nicht wirklich relevant.

Aber wie immer möchte ich was lernen und muss deswegen nochmal nachhaken.
@Uwe: "ReDim arrProdukte(1 To Rng.SpecialCells(xlCellTypeVisible).CountLarge / 3, 1 To Rng.Columns.Count)"
Dass .CountLarge alle gefüllten Zellen zählt ist klar. Aber warum durch 3 teilen? Ist das ein fixer Wert den ich nicht verstehe oder ist das die Anzahl an Spalten (also eigentlich Rng.Columns.Count)?

Und nach einigem Draufrumdenken, werde ich jetzt doch die Lösung von snb versuchen, da ich die Daten als Array benötige, um sie weiterzuverarbeiten, aber zusätzlich in einem anderen Blatt ausgebe.
Dann kopiere ich sie erst gefiltert ins neue Blatt und schreibe sie dann ins Array.

Vielen Dank für Eure Hilfe.

[Egon12]

Hallo,
 
/ 3 ist logisch, da wie du festgestellt hast alle gefilterte Zellen gezählt werden. 36 gefilterte Zellen / 3 = 12 Zeilen zu 3 Spalten.
Und ja man kann so wie ich es schon in #6 geschrieben hatte mit dem AdvancedFilter kurz und knackig bauen, statt gefilterte Areas eines Ranges zu durchlaufen.
 
Gruß Uwe

[knobbi38]

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.

Hier mal der Code, wie man die Areas-Bereiche in ein Array übertragen kann, wenn die Bereiche nicht zusammenhängend sind:

Code:

Option Explicit

Sub RangeToArray()

  Dim wsh As Worksheet
  Dim rngData As Range                ' Hält alle sichtbaren Zellen nach dem Filtern
  Dim rngArea As Range                ' Hilfsvariable für zusammenhängende Zellblöcke (Areas)
  Dim lngCols As Long                 ' Anzahl der Spalten
  Dim lngRows As Long                 ' Gesamtzahl der sichtbaren Datenzeilen
  Dim aData() As Variant              ' Das Haupt-Array für das Ergebnis
  Dim aArea() As Variant              ' Temporäres Array für eine einzelne "Area"
  Dim i As Long, k As Long, n As Long ' Zählvariablen für Schleifen
 
  ' --- Konstanten für die Blattnamen ---
  Const SHT_NAME As String = "Rohstoffe_1"
  Const SHT_TARGET As String = "Ergebnis"
 
  Set wsh = Worksheets(SHT_NAME)
 
  ' 1. Filter vorbereiten: Bestehende Filter aufheben, um alle Daten zu berücksichtigen
  If wsh.FilterMode Then wsh.ShowAllData
 
  ' 2. Autofilter setzen: Spalte 4 (D) nach dem Wert "X" filtern
  wsh.Range("$A:$E").AutoFilter Field:=4, Criteria1:="X"
 
  ' 3. Nur sichtbare Zellen referenzieren (überspringt ausgeblendete Zeilen)
  Set rngData = wsh.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
 
  ' 4. Dimensionen berechnen
  lngCols = rngData.Columns.CountLarge
 
  ' Zeilen berechnen: Gesamtzahl sichtbarer Zellen geteilt durch Spaltenanzahl
  lngRows = rngData.Cells.CountLarge \ lngCols
  lngRows = lngRows - 1                 ' Header-Zeile abziehen
 
  ' 5. Ziel-Array dimensionieren (0-basierte Indizierung)
  ReDim aData(lngRows - 1, lngCols - 1) As Variant
  n = -1                                ' Zeilenindex für das Ziel-Array
 
  ' 6. Daten aus den gefilterten "Areas" auslesen
  For Each rngArea In rngData.Areas
    ' Überspringe die Verarbeitung, wenn die Area die Überschrift (Zeile 1) ist
    If rngArea.Row > 1 Then
       ' Den aktuellen zusammenhängenden Block für mehr Speed in ein temporäres Array laden
       aArea = rngArea.Value
     
      ' Zeilen der aktuellen Area durchlaufen
      For i = LBound(aArea) To UBound(aArea)
        n = n + 1
       
        ' Spalten durchlaufen, um Daten in das Haupt-Array zu übertragen
        For k = 0 To lngCols - 1
          aData(n, k) = aArea(i, k + 1)
        Next
      Next
    End If
  Next
 
  ' 7. Ausgabe: Das gesamte Array in das Ziel-Tabellenblatt schreiben
  ' Resize passt den Zielbereich exakt an die Array-Dimensionen an
  Worksheets(SHT_TARGET).Range("A1").Resize(lngRows, lngCols).Value = aData
 
  ' --- Speicherbereinigung ---
  Set rngArea = Nothing
  Set rngData = Nothing
  Set wsh = Nothing
End Sub

Anm.: die Kommentierung habe ich mal der Einfachheit halber durch eine KI machen lassen 

Knobbi38

[Andreas Killer]

Aber wie immer möchte ich was lernen

Code:

Option Explicit
Option Compare Text

Private Sub B_Daten_Einlesen()
  Dim Source As Range
  Dim Data, arrProdukte
  Dim i As Long, j As Long, k As Long
 
  'Alle Daten in A:D einlesen
  Set Source = Range("A1", Range("D" & Rows.Count).End(xlUp))
  Data = Source.Value
  'Benötigte Zeilen zählen
  For i = 1 To UBound(Data)
    If Data(i, 4) = "X" Then k = k + 1
  Next
  'Array erzeugen
  ReDim arrProdukte(1 To k, 1 To UBound(Data, 2))
  'Daten kopieren
  k = 0
  For i = 1 To UBound(Data)
    If Data(i, 4) = "X" Then
      k = k + 1
      For j = 1 To UBound(Data, 2)
        arrProdukte(k, j) = Data(i, j)
      Next
    End If
  Next
  'Ausgeben
  Range("H2").Resize(UBound(arrProdukte), UBound(arrProdukte, 2)).Value = arrProdukte
End Sub

[snb]

Oder so:

sn ist das Array
die letzte Zeile ist nur für Verifikation

Code:

Sub M_snb()
    With CreateObject("New:{8BD21D20-EC42-11CE-9E0D-00AA006002F3}") '  - Microsoft Forms 2.0 ListBox
      .List = [if(D2:D100="X",A2:C100)]
      For j = .ListCount - 1 To 0 Step -1
          If .List(j, 0) = False Then .RemoveItem j
      Next
      sn = .List
    End With
   
    Cells(20, 8).Resize(UBound(sn) + 1, 3) = sn
End Sub

[schauan]

... oder so?

Code:

Sub tester()
Dim wksQuelle As Worksheet, Rng As Range, arrProdukte
Set wksQuelle = Sheets("Rohstoffe_1")
With wksQuelle
    Set Rng = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4))
    arrProdukte = Evaluate("FILTER(" & Rng.Resize(, 3).Address & "," & Rng.Columns(4).Address & "=""X"")")
    On Error Resume Next
    .Cells(2, 8).Resize(UBound(arrProdukte, 1), UBound(arrProdukte, 2)) = arrProdukte
    If Err.Number = 9 Then Range("H2:J2") = arrProdukte
End With
End Sub

Hinweise:
- Dein Zielbereich sollte vor dem Eintrag des Ergebnisses geleert werden, sonst gibt's vielleicht Rester des vorherigen Ergebnisses

[knobbi38]

@Andreas Killer

Es ging ja gerade darum, keinen Zugriff über die Zell-Objekte in einer Schleife zu machen, sondern das Ganze zunächst  in ein Array einzulesen und dann auszuwerten.

Knobbi38

[Egon12]

nun auch noch ein Schleifchen von mir:

Code:

Sub NochNeSchleife()
    Dim i&, j&, k&, arrL(), arrT(): arrT = Tabelle21.Range("A2:D" & Tabelle21.Cells(Rows.Count, 1).End(xlUp).Row).Value
    arrL = arrT
    For i = LBound(arrL) To UBound(arrL)
        If arrT(i, 4) = "X" Then
            k = k + 1
            For j = 1 To 3
                arrL(k, j) = arrT(i, j)
            Next j
        End If
    Next i
    Tabelle21.Cells(2, 8).Resize(k, 3) = arrL
End Sub

Gruß Uwe

[Egon12]

und hier noch die Variante Recordset:

Code:

Sub GanzSchnell()
    Dim rs As Object, arr
    Set rs = CreateObject("ADODB.Recordset")
    With rs
        .CursorLocation = 3
        .CursorType = 3
        .Open "SELECT * FROM [Rohstoffe_1$]", "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0 xml"";" & "Data Source= " & ThisWorkbook.FullName
        .Filter = "Exklusiv = 'X'"
        If (.EOF And .BOF) = False Then Tabelle21.Cells(2, 8).Resize(.RecordCount, 3) = Application.Transpose(.GetRows)
        .Close
    End With
    Set rs = Nothing
End Sub

Man kann auch gleich im Select From String mit Where Abfrage dies erschlagen dann vielleicht so:

Code:

Sub MitSQLAbfrage()
    Dim rs As Object, sSQL$, sConn$
    Set rs = CreateObject("ADODB.Recordset")
    sSQL = "SELECT [Component], [BOM Component Description], [Comp# Plant-Sp Matl Status] " & "FROM [Rohstoffe_1$] " & "WHERE [Exklusiv] = 'X'"
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0 Xml;HDR=Yes"";" & "Data Source=" & ThisWorkbook.FullName
    rs.Open sSQL, sConn, 1, 1
    If Not (rs.EOF And rs.BOF) Then Tabelle21.Cells(2, 8).Resize(rs.RecordCount, 3).Value = Application.Transpose(rs.GetRows)
    rs.Close
    Set rs = Nothing
End Sub

Gruß Uwe

[Andreas Killer]

@Andreas Killer

Es ging ja gerade darum, keinen Zugriff über die Zell-Objekte in einer Schleife zu machen, sondern das Ganze zunächst  in ein Array einzulesen und dann auszuwerten.

Knobbi38

Wenn Dir mein kommentierter Code nicht verständlich genug ist, dann würde ich es zu schätzen wissen wenn Du Kommentare dieser Art in Zukunft lässt.