Office: 2D Array filtern und Ergebnis in weiterem Array ausgeben

Helfe beim Thema 2D Array filtern und Ergebnis in weiterem Array ausgeben in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Guten Morgen VBA Profs, ich habe eine Tabelle die ein Kriterium "A" für AKtiv oder "I" für Inaktiv in der vierten Spalte aufweist. Ich möchte einen... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von RogMan, 8. Oktober 2016.

Seite 1 von 2

ROGMAN

RogMan

2D Array filtern und Ergebnis in weiterem Array ausgeben

Guten Morgen VBA Profs, ich habe eine Tabelle die ein Kriterium "A" für AKtiv oder "I" für Inaktiv in der vierten Spalte aufweist. Ich möchte einen Filter einbauen und in einem userfom.Listenfeld die gefilterten Daten ausweisen.
Leider kriege ich den zweiten Array, mit den gefilterten Daten nicht gefüllt ....
Kann mir jemand helfen?

Code:

Private Sub UserForm_Initialize()
Dim myArray() As Variant, i As Long, j As Long
Dim myArray2() As Variant

myArray() = Range("zz_DB!Projektleiter").Value 'fill array with values from range
fncFiltereAktiveProjektleiter (myArray)

Me.LSTBPL.List = T1Arr ' der komplette array wird in die Listebox geschrieben
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Function fncFiltereAktiveProjektleiter(myArray) As Variant
Dim T1Arr() As Variant
Dim i As Long, j As Long

For i = 1 To UBound(myArray, 1) ' in Zeile (hochzählen bis maximale Zeilenanzahl)
If myArray(i, 4) = "A" Then
For j = UBound(myArray, 2) To 1 Step -1 ' in Spalte (hochzählen bis maximale Spaltenanzahl)
T1Arr = myArray(i, j)
' Debug.Print myArray(i, j) ' Drucke in jeder Zeile die jeweilige Spalte aus
' Debug.Print T1Arr(i, j) ' Drucke in jeder Zeile die jeweilige Spalte aus
Next
End If
Next

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Warum lässt sich "T1Arr" nicht füllen. Die Meldung "Typen unverträglich" stoppt den Code ...

:)

RogMan, 8. Oktober 2016

#1
ALOYS78

aloys78

Hallo,

mein Vorschlag ohne gesonderte Funktion:
Code:

Dim myArray As Variant
Dim myArray2() As Variant
Dim T1Arr() As Variant

Dim i As Long, j As Long, z As Long

myArray = Range("zz_DB!Projektleiter") 'fill array with values from range
ReDim myArray2(1 To UBound(myArray), 1 To UBound(myArray, 2))
z = 0
For i = 1 To UBound(myArray) ' in Zeile (hochzählen bis maximale Zeilenanzahl)
If myArray(i, 4) = "A" Then
z = z + 1 ' Anzahl 'A'
For j = 1 To UBound(myArray, 2) ' in Spalte (hochzählen bis maximale Spaltenanzahl)
myArray2(z, j) = myArray(i, j)
' Debug.Print myArray(i, j) ' Drucke in jeder Zeile die jeweilige Spalte aus
' Debug.Print T1Arr(i, j) ' Drucke in jeder Zeile die jeweilige Spalte aus
Next j
End If
Next i
ReDim T1Arr(1 To z, 1 To UBound(myArray2, 2))
'Range("M2:P7") = myArray2 'nur Test
T1Arr = myArray2

'Range("H2:K" & z + 1) = T1Arr 'nur Test
' Me.LSTBPL.List = T1Arr 'nicht getestet
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Aloys

aloys78, 9. Oktober 2016

#2
R J

R J

Hi Rogman,

lese ich das richtig? Du willst lediglich die Daten, bei denen in Spalte 4 (von wo aus auch immer betrachtet) ein A vorkommt in eine mehrspaltige Listbox schreiben? Wozu dann der Umweg über mehrere Arrays? Das kannst Du auch direkt machen.

Bedingungen:
Ich habe hier den Datenbereich von Tabelle1, A1 bis D3 definiert.
Meine Listbox heißt lbFilter
Auslösendes Ereignis: UserForm_Activate
Prozedur, die das realisiert: ListboxFüllen

Code:

Option Explicit

Private Sub UserForm_Activate()
ListboxFüllen
End Sub

Sub ListboxFüllen()

Dim zeile As Long, spalte As Long, lz&, Wertliste() As Variant

Wertliste() = Tabelle1.Range("A1:D3").Value
lbFilter.Clear

For zeile = 1 To UBound(Wertliste())
If LCase(Wertliste(zeile, 4)) = "a" Then
For spalte = 1 To 4
lbFilter.AddItem
lbFilter.List(0 + lz, spalte - 1) = Wertliste(zeile, spalte)
Next spalte
lz = lz + 1
End If
Next zeile
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

R J, 9. Oktober 2016

#3
ROGMAN

RogMan

2D Array filtern und Ergebnis in weiterem Array ausgeben

Danke Euch Beiden Aloys und Ralf,
ich habe Ralfs Lösung genommen, weil dies eine direkte ist und es klappt super *Smilie

RogMan, 10. Oktober 2016

#4
XLPH

xlph

Wenn dann so...

Code:

Option Explicit

Private Sub UserForm_Activate()
ListboxFüllen
End Sub

Sub ListboxFüllen()

Dim zeile As Long, spalte As Long, lz&, Wertliste() As Variant

Wertliste() = Tabelle1.Range("A1:D3").Value
lbFilter.Clear

For zeile = 1 To UBound(Wertliste())
If LCase(Wertliste(zeile, 4)) = "a" Then
lbFilter.AddItem
For spalte = 1 To 4
lbFilter.List(0 + lz, spalte - 1) = Wertliste(zeile, spalte)
Next spalte
lz = lz + 1
End If
Next zeile
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wozu dann der Umweg über mehrere Arrays?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ganz einfach, es ist um den Faktor 10 schneller.

AddItem 6,257813
Array 0,6328125

Testmenge 65.500 Zeilen

xlph, 10. Oktober 2016

#5
ROGMAN

RogMan

Hi xlph, wenn das so viel schneller ist, kannst Du mir dann helfen mit der Lösung die ich zu Beginn suchte?

RogMan, 11. Oktober 2016

#6
XLPH

xlph

lade die Datei hoch

xlph, 11. Oktober 2016

#7
ROGMAN

RogMan

2D Array filtern und Ergebnis in weiterem Array ausgeben

Hallo xlph, hier ist die Datei ...
http://www.imagenetz.de/f8eb1cd09/Au...est1.xlsm.html

RogMan, 11. Oktober 2016

#8
R J

R J

Hi RogMan,

hab Dir das mal mit einer SQL - Variante gelöst.
Bedingung ist allerdings, dass ich eine neue Tabelle (im Beispiel Tabelle10) eingefügt habe.
Klar, man kann das Ergebnis auch in eine vorhandene schreiben, aber so ging es schneller (zu entwickeln....*wink.gif* )

Code:

Private Sub UserForm_Initialize()

Dim cnstr$, strQuellblatt$, sql$
Dim cn As Object, rs As Object

strQuellblatt = Tabelle1.Name

cnstr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0;HDR=YES"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open cnstr

sql = "SELECT tbl.[Projektleiter], tbl.[ID], tbl.[IDNR], tbl.[IDNR2]" & _
"FROM [" & strQuellblatt & "$] AS tbl " & _
"WHERE (tbl.[IDNR2]='A') " & _
"ORDER BY tbl.[Projektleiter] "

rs.Open sql, cn

With Sheets("Tabelle10") 'Tabelle10 wurde als "Hilfstabelle" angelegt. Falls nicht vorhanden oder schon vergeben, dann anpassen
.Cells.ClearContents
.Range("a1").CopyFromRecordset rs
Me.LSTBPL.RowSource = .Name & "!" & .UsedRange.Address
End With

Set cn = nothing
Set rs = nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wobei ich den Code in eine eigene Prozedur auslagern würde. Wenn Du dann noch mit Parametern arbeitest, hast Du ein ziemlich flexibles Werkzeug in der Hand.

R J, 12. Oktober 2016

#9
XLPH

xlph

Eine Beschreibung wäre nicht schlecht.

Was wo wie?

xlph, 12. Oktober 2016

#10
R J

R J

\@xlph,

nun ja, es betrifft das Initialize Ereignis der Form FrmNewPL. Das betraf es doch schon immer, oder nicht?

Hier noch eine etwas flexiblere Variante:
Code:

Private Sub UserForm_Initialize()
Dim strSQL$
strSQL = CreateSQLString(Array("Projektleiter", "ID", "IDNR", "IDNR2"), Tabelle1.Name, "IDNR2", "A", "Projektleiter")
SQLAuswahl strSQL
End Sub

Sub SQLAuswahl(sql As String)
Dim cnstr$
Dim cn As Object, rs As Object

Me.LSTBPL.Clear
cnstr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0;HDR=YES"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open cnstr
rs.Open sql, cn

With Sheets("Tabelle10") 'Tabelle10 wurde als "Hilfstabelle" angelegt. Falls nicht vorhanden oder schon vergeben, dann anpaasen
.Cells.ClearContents
.Range("a1").CopyFromRecordset rs
Me.LSTBPL.RowSource = .Name & "!" & .UsedRange.Address
End With
Set cn = Nothing
Set rs = Nothing
End Sub

Function CreateSQLString(ausSpalten As Variant, ausTabelle As String, Optional SpalteBedingung As String, Optional WertBedingung As String, Optional sortieremit As String) As String
'Funktion liefert einen SQL String (Nur Select, ohne Distinct) gem. der übergebenen Parameter
'Parameter:
'ausSpalten = Stringarray
'ausTabelle = Name der Quelltabelle
'optionale Parameter'
'SpalteBedingung = Bezeichnung der Spalte, für die eine Bedingung gesetzt werden soll (optional)
'WertBedingung = Wert der Bedingung
'-> zur Zeit werden für die Bedingung keine Datums- oder Zahlenwerte akzeptiert.
'Auch LIKE ist nicht möglich, Es kann bis jetzt auch nur eine Bedingung gesetzt werden
'sortieremit = Name der Spalte, nach der sortiert werden soll. Bis jetzt auch nur eine Spalte möglich
'Wer mag, kann ja die "Einspaltenrestriktion" mittels entsprechender Arrays aufheben...;)

Dim strSQL$, strBed$, strSort$, var, strSpalten$
strSort = IIf(sortieremit = "", "", " ORDER BY tbl.[" & sortieremit & "]")
strBed = IIf(SpalteBedingung = "" Or WertBedingung = "", "", "WHERE (tbl.[" & SpalteBedingung & "] = '" & WertBedingung & "') ")

For Each var In ausSpalten
strSpalten = strSpalten & " tbl.[" & var & "], "
Next

strSpalten = VBA.Left(strSpalten, VBA.Len(strSpalten) - 2)

strSQL = "SELECT " & strSpalten & " FROM [" & ausTabelle & "$] as tbl " & strBed & strSort
CreateSQLString = strSQL

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

...soweit ok für Dich?

R J, 12. Oktober 2016

#11
XLPH

xlph

\@RJ

wenn du schon mit ADO arbeitest, dann kannst du dir die Ausgabe in einem Temp-Blatt sparen, indem du das Recordset als Array (.GetRows) ausgeben lässt.

xlph, 12. Oktober 2016

#12
ROGMAN

RogMan

2D Array filtern und Ergebnis in weiterem Array ausgeben

Hallo Ralf, ok ... SQL ... ich habe keine Ahnung .... Das geht, wenn ich es richtig interpretiere auch anstelle eines VBA Codes?
Ich bin ein absoluter Amateur und versuche mein bestes mir das Ganze selbst zusammen zu basteln. Das mit dem SQL ist Momentan Bahnhof für mich. Ich werde mich da in den nächsten Tagen mal versuchen rein zu lesen.

Grundsatzfrage:
Kann mir jemand erklären. warum ich einen Array nicht auswerten und das Ergebnis in einen anderen Array schreiben kann?
Die Fehlermeldung "TYpen unverträglich" verstehe ich nicht. Es sind beide Arrays als "Variant" definiert, ergo die selben Typen .....

RogMan, 12. Oktober 2016

#13
R J

R J

\@xlph,

wenn du schon mit ADO arbeitest, dann kannst du dir die Ausgabe in einem Temp-Blatt sparen, indem du das Recordset als Array (.GetRows) ausgeben lässt.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

...stimmt! Allerdings müssen wir dann der Vollständigkeit halber auch erwähnen, dass die Listbox bei direkter Zuweisung nicht mit Me.Listboxname.RowSource sondern mit Code:

arr = rs.getrows()
Me.Listboxname.Column = arr
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

befüllt werden muss.

@RogMan,

das ist im VBA Code eingebettet. Du musst also nichts daran ändern.

Kann mir jemand erklären. warum ich einen Array nicht auswerten und das Ergebnis in einen anderen Array schreiben kann?
Die Fehlermeldung "TYpen unverträglich" verstehe ich nicht. Es sind beide Arrays als "Variant" definiert, ergo die selben Typen .....
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Habe jetzt leider Deinen Originalcode nicht mehr, kann deshalb jetzt nicht nachvollziehen, wo das Problem war. Aber... zum Kopieren von Variant- Arrays, probiere mal das:

Code:

Sub arr()
Dim arr1, arr2, var
arr1 = Range("D1:G6")

For Each var In arr1
Debug.Print var
Next

arr2 = arr1

For Each var In arr2
Debug.Print var
Next

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

R J, 12. Oktober 2016

#14
XLPH

xlph

Hier die Array-Variante

xlph, 12. Oktober 2016

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 2

Thema:

2D Array filtern und Ergebnis in weiterem Array ausgeben

Die Seite wird geladen...

2D Array filtern und Ergebnis in weiterem Array ausgeben - Similar Threads - Array filtern Ergebnis
Mittelwert aus mehreren Spalten als dynamisches Array
in Microsoft Excel Hilfe
Mittelwert aus mehreren Spalten als dynamisches Array: Hallo liebes Forum, ich bin bei folgendem Problem ratlos: Ich berechne für verschiedene Dozenten Feedback anhand von 3 verschiedenen Kriterien. Die Stammdaten der Feedbacks stehen in einer...
Adressen in eine Zelle bei Übereinstimmung eindeutiger Werte einer anderen Spalte
in Microsoft Excel Hilfe
Adressen in eine Zelle bei Übereinstimmung eindeutiger Werte einer anderen Spalte: Hallo zusammen, wer letzteren Thread kennt, hier eine Neuauflage. Problem: Aus Array-Berechnungen (Variablen von Let) ein weiteres Array zu erzeugen, welches für alle eindeutigen Werte aus G die...
Zahlendubletten im Array
in Microsoft Excel Hilfe
Zahlendubletten im Array: Guten Morgen liebe Community, anbei ein vereinfachtes Beispiel der Problematik, da das Original mehrere LAMBDA-Funktionen und Tabellen mit einbezieht. Ich benötige die Lösung, um eine weitere...
Array aus Excel Tabelle einlesen Word VBA
in Microsoft Excel Hilfe
Array aus Excel Tabelle einlesen Word VBA: Hallo, ich benötige in einer Word Datei die Werte einer Excel Datei. Ich würde gerne eine Spalte als Array einlesen. Wie das Array ein lesen in Excel geht weiß ich, aber wie schaffe ich den...
Summenteilergebnis eines Arrays als Array darstellen
in Microsoft Excel Hilfe
Summenteilergebnis eines Arrays als Array darstellen: Hallo Community, Summenteilergebnis eines Arrays als Array darstellen. An dieser Stelle stecke ich fest. Ich habe eine Testmappe erstellt, die die Problematik versucht darzustellen. Bevor jemand...
Array Formel Filtern nach mehreren Kriterien
in Microsoft Excel Hilfe
Array Formel Filtern nach mehreren Kriterien: Hallo Excel Gurus, ich habe einem Array Formel gefunden um von der einen Tabelle bestimmte Felder in eine andere Tabelle zu transportieren. Abhängig von einem bestimmte Eintrag (Apfel) in einen...
VBA Array Filter
in Microsoft Excel Hilfe
VBA Array Filter: Hallo zusammen habe folgendes Problem: Ich habe ein Tabellenblatt mit 20000 Artikeln, es gibt bestimmte Artikel die mit "ST" anfangen und ich hätte nun gerne alle diese Artikel mit...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden