Einzelne Listojekt Spalte aus Array Füllen

Forumthread: Einzelne Listojekt Spalte aus Array Füllen

19.08.2019 11:30:43

Andreas

Hallo Liebe Forum Mitglieder
Ich bin auf der suche nach etwas Hilfe bei einem Makro das ursprünglich mit Hilfe dieses Forums entstanden ist. Und zwar, ich versuche es dahingehen zu ändern das ich die Werte für eine Hilfspalte nicht direkt in die Tabelle schreibe, sondern zuerst in ein Array und dann das Array auf einmal in eine Hilfspalte. Es funktioniert aber nicht.
Es wird nur der erste Wert des Arrays in alle Zellen der Hilfsspalte geschrieben. Ich würde eine schleife gerne vermeiden weil die Zeilenanzahl so groß ist, das es recht lange dauert. Wenn es einzelne Tabellenzugriffe sind. Ich hab es bis jetzt auf zwei Arten Probiert.

iTabDaten.ListColumns(29).DataBodyRange = arrSichtbar

und

wsDaten.Range(Cells(2, iDatenLS + 1), Cells(iDatenLZ, iDatenLS + 1)) = arrSichtbar

Immer mit dem selben falschen Ergebnis.
Hintergrund:
Ich will Zeilen die durch einen Advancefilter ausgeblendet wurden über die eingeblendeten Zeilen Sortiere.
Dazu setze ich zuerst den Advancefilter.
Erfasse dann in einem gleichgroßen Array welche Zeilen EIN/AUS geblendet sind indem ich einfach nur die Buchstaben A (Ausgeblendet) und E (eingeblendete) in das Array Schreibe.
Anschließend löse ich den Advancefilter wider auf. Und würde gerne das Array auf einen schlag in eine Hilfsspalte der Tabelle Schreiben. (Was nicht funktionieren will)
Dann sortiere ich nach der Hilfsspalte.
Lösche den Inhalt der Hilfspalte.
Und Setze den Advance Filter wider ein
Wäre für eure Hilfe wirklich dankbar und natürlich auch für jeden Verbesserungsvorschlag.
Danke und Grüße
Andreas
PS Ganzer Code Folgt noch.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Einzelne Listojekt Spalte aus Array Füllen

19.08.2019 11:40:01

Andreas

Das wäre der ganze Code den ich verwende

 Sub ZeilenUmsortieren()
Dim wsDaten As Worksheet
Dim iTabDaten As ListObject
Set wsDaten = ThisWorkbook.Worksheets("Daten")
Set iTabDaten = wsDaten.ListObjects("Daten_IntelligenteTabelle")
Dim iDatenLZ As Long, iDatenLS As Long
Dim i As Integer
Dim arrSichtbar As Variant
''Letzte zeile und letze Spalte des Listojekt erfassen
iDatenLS = iTabDaten.ListColumns.Count
iDatenLZ = wsDaten.ListObjects("Daten_IntelligenteTabelle").ListRows.Count + 1
''Dimensionieren des Arrays
ReDim arrSichtbar(2 To iDatenLZ)
''Advancefilter setzen
Call SpezialfilterDatum1(True)
''Erfassen welche Zeilen eingebledetet und welche ausgeblendet sind in einem Array
For i = iDatenLZ To 2 Step -1
If iTabDaten.Range.Rows(i).Hidden = True Then
arrSichtbar(i) = "A"
Else
arrSichtbar(i) = "E"
End If
Next
''Advancfilter auflösen
If wsDaten.FilterMode = True Then wsDaten.ShowAllData
''Array in Hilfsspalte übernehmen
iTabDaten.ListColumns(iDatenLS + 1).DataBodyRange = arrSichtbar
''Sortieren Nach Hilfsspalte
Range("Daten_IntelligenteTabelle[#All]").Select
With iTabDaten
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("Daten_IntelligenteTabelle[S29]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
''Inhalt hilfsspalte Löschen
iTabDaten.DataBodyRange.Columns(iDatenLS).ClearContents
''Advancefilter  wider setzen
Call SpezialfilterDatum1
Range("A1").Select
End Sub

Sub SpezialfilterDatum1(Optional Kriterien As Boolean)
Dim Von As Date, Bis As Date
Dim wsZeitraum As Worksheet, wsDaten As Worksheet
Dim iTabZeitraum As ListObject, iTabDaten As ListObject
Set wsDaten = ThisWorkbook.Worksheets("Daten")
Set iTabDaten = wsDaten.ListObjects("Daten_IntelligenteTabelle")
'Filter Löschen
If wsDaten.AutoFilterMode = True Then If wsDaten.FilterMode = True Then wsDaten.AutoFilter. _
ShowAllData
''Wenn True Übergeben dann Kriterien Bereich erstellen
If Kriterien Then
Von = wsDaten.OLEObjects("TextBox1").Object.Value 'Von
Bis = wsDaten.OLEObjects("TextBox2").Object.Value 'Bis
wsDaten.Range("AF23:AG23").Value = "Von"
wsDaten.Range("AH23:AI23").Value = "Bis"
wsDaten.Range("AF24").Value = ">=" & CLng(Von)
wsDaten.Range("AH24").Value = ">=" & CLng(Von)
wsDaten.Range("AG24").Value = "=" & CLng(Bis)
wsDaten.Range("AG25").Value = ">=" & CLng(Von)
wsDaten.Range("AH25").Value = "=" & CLng(Von)
wsDaten.Range("AG26").Value = "

Grüße Andreas

AW: Einzelne Listojekt Spalte aus Array Füllen

19.08.2019 11:41:27

Daniel

Hi
wie wird denn das Array arrSichtbar erstellt und ist es ein- oder zweidimenional?
eindimensionale Arrays werden, wenn sie in Tabellenblätter geschrieben werden, wie zweidimensionale Arrays, die aus einer Zeile und vielen Spalten bestehen, behandelt.
entweder du erstellst dein arrSichtbar als zweidimensionales Array mit vielen Zeilen und einer Spalte
oder wenn du beim eindimensionalen Array bleiben willst, musst du beim zurückschreiben transponieren:

iTabDaten.ListColumns(29).DataBodyRange = Worksheetfunction.Transpose(arrSichtbar)

Gruß Daniel

AW: Einzelne Listojekt Spalte aus Array Füllen

19.08.2019 12:55:26

Andreas

Hallo Daniel
Danke für die Antwort
So hat es bis jetzt ausgesehen, also Eindimensional

Dim arrSichtbar As Variant
''Dimensionieren des Arrays
ReDim arrSichtbar(2 To iDatenLZ)
''Erfassen welche Zeilen eingebledetet und welche ausgeblendet sind in einem Array
For i = iDatenLZ To 2 Step -1
If iTabDaten.Range.Rows(i).Hidden = True Then
arrSichtbar(i) = "A"
Else
arrSichtbar(i) = "E"
End If
Next
''Array in Hilfsspalte übernehmen
iTabDaten.ListColumns(29).DataBodyRange = arrSichtbar

Transponieren Funktioniert vielen dank. :)
Was ist den Prinzipiell Besser/Schneller, Transponieren oder ein zweidimensionales Array verwenden? Hast du vielleicht noch irgendwelche Vorschläge wie ich das Makro besser machen kann. Vor allem in punkto Geschwindigkeit. Abgesehen vom ausschalten der Bildschirm Aktualisierung usw. meine ich.
Aus Solchen Vorschlägen lerne ich immer sehr viel, deswegen die frage.
Ursprünglich hatte ich es direkt in die Tabelle geschrieben mit

For i = iDatenLZ To 2 Step -1
If iTabDaten.Range.Rows(i).Hidden = True Then
wsDaten.Cells(i, iDatenLS + 1).Value = "A"
Else
wsDaten.Cells(i, iDatenLS + 1).Value = "E"
End If

Aber das war zu langsam weil es so viele Zeilen sind.
Grüße
Andreas

AW: Einzelne Listojekt Spalte aus Array Füllen

19.08.2019 13:18:15

Daniel

hi
kommt auf deine Excelversion und die Datenmenge an.
in den älteren Excelversionen (bis 2010) war Transponieren recht langsam und hatte ein Limit bei 65536 Zeilen/Spalten)
ab 2013 scheint das Transponieren schneller geworden zu sein und das Limit gilt auch nicht mehr.
wenn du das ganze gleich in 2-D machst, musst halt immer den 2. Parameter mitführen, dafür sparst du am Schluss das transponieren.

ReDim arrSichtbar(2 To iDatenLZ, 1 to 1)
arrSichtbar(i, 1) = "A"

zu dem ganzen nochmal ne ganz andere Idee wie du das schleifenfrei machen könntest:
Ergänze in der Tabelle, die du mit dem Spezialfilter bearbeitest, eine Spalte mit der Formel: =Teilergebnis(103;A1)
wobei A1 ein bezug auf eine Zelle in der gleichen Zeile die einen Wert enthält, sein sollte.
das Ergebnis der Teilergebnisformel ist 1 für eingeblendet und 0 für ausgeblendet.
das ergebnis kannst du dann entweder direkt in ein Array einlesen, oder du kannst die Werte direkt übertragen, aber dann mit Range(...).Value = Range(...).Value
das währe wahrscheinlich am schnellsten und würde dir jede Menge Programmieraufwand sparen
Gruß Daniel

Infobox / Tutorial