formatierte Tabelle bei einfügen entsprechend verlängern

Forumthread: formatierte Tabelle bei einfügen entsprechend verlängern

09.01.2024 16:52:03

Fred

Hallo Excelaner,
ich habe wohl ein eher leichtes Problem. Ich will eine "Unikat-Liste" in eine formatierte Tabelle kopieren:

Sub Orte_UnikatsListe()

    Dim LZ_1 As Long

    

    LZ_1 = Sheets("Orte").Cells(Rows.Count, 1).End(xlUp).Row



    Sheets("Orte").Range("B11:B" & LZ_1).AdvancedFilter Action:=xlFilterCopy, _

    CopyToRange:=Sheets("Länder").Range("A11"), Unique:=True

End Sub

Problem: Beim Einfügen entsprechender Daten wird die formatierte Tabelle nicht entsprechend verlängert (Zeilen)- wenn es mehr Daten gibt.
Kann mir bitte ein Experte die Lösung schreiben?!

Gruss
Fred

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: formatierte Tabelle bei einfügen entsprechend verlängern

09.01.2024 17:09:44

Yal

Hallo Fred,

weil eine AdvancedFilter nicht das Ereignis auflöst, was ein Kopieren auflösen würde.
Du kannst aber die Erweiterung der Tabelle selber forcieren:

    With Worksheets("Orte")

        Set NeueLetzteZelle = .Cells(Rows.Count, 1).End(xlUp)

        .ListObjects(1).Resize Range(.ListObjects(1).DataBodyRange.Cells(1), NeueLetzteZelle) 'hier gehe ich davon aus, dass die Tabelle nur eine Spalte hat!

    End With

VG
Yal

AW: formatierte Tabelle bei einfügen entsprechend verlängern

09.01.2024 18:43:35

Fred

autsch Yal,
deine passende Antwort habe ich die letzte Stunde nicht lesen können.
In der Zeit hatte ich natürlich selbst um eine Lösung gesucht.
Das Konstrukt:

Sub Orte_UnikatsListe()

    Dim OrteSheet As Worksheet

    Dim LänderSheet As Worksheet

    Dim OrteData As Variant

    Dim UniqueData As Variant

    Dim UniqueDict As Object

    Dim i As Long

    Dim NextRow As Long



   

    Set OrteSheet = ThisWorkbook.Sheets("Orte")

    Set LänderSheet = ThisWorkbook.Sheets("Länder")

    OrteData = Orteheet.Range("B11:B" & LigaSheet.Cells(Rows.Count, 1).End(xlUp).Row).Value

    Set UniqueDict = CreateObject("Scripting.Dictionary")



    For i = 1 To UBound(LigaData, 1)

        If Not UniqueDict.Exists(OrteData(i, 1)) Then

            UniqueDict.Add OrteData(i, 1), Nothing

        End If

    Next i



    ReDim UniqueData(1 To UniqueDict.Count, 1 To 1)

    i = 1

    For Each Key In UniqueDict.Keys

        UniqueData(i, 1) = Key

        i = i + 1

    Next Key



    NextRow = 11

    LänderSheet.Range("A" & NextRow).Resize(UBound(UniqueData, 1), UBound(UniqueData, 2)).Value = UniqueData

End Sub

In diesem Code wird die Unikat-liste mithilfe eines Dictionarys erstellt und dann in die "Länder"-Tabelle eingefügt.
als erstes habe ich die Referenzen auf die betreffenden Blätter gesetzt
dann die Daten aus "Orte" in ein Array eingelesen
für die Einzigartigkeitsprüfung ein Dictionary Initialisiert
dann wird das Array durchlaufen und das Dictionary gefüllt und die eindeutigen Werte in ein Array übertragen
Letztlich der Startpunkt in "Länder" auf A11 gesetzt und das Array mit den eindeutigen Werten nach "Länder" übertragen

Als Vorlage für dieses Konstrukt waren die Code-Beispiele der letzten Zeit von MCO, Daniel, Onur
und Herrn Zufall :-)
Das Arbeiten mit Arrays ist echt cool, aber so ein Ding ohne Beispiel-Codes bekomme ich noch nicht hin. Noch unglaublich viel "try and error"

Gruss
Fred

Beliebteste Forumthreads (12 Monate)

formatierte Tabelle bei einfügen entsprechend verlängern

Forumthread: formatierte Tabelle bei einfügen entsprechend verlängern

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

formatierte Tabelle bei einfügen entsprechend verlängern

Forumthread: formatierte Tabelle bei einfügen entsprechend verlängern

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread