|
Moin Moin mein Namensvetter ;-),
erst mal danke für deine Hilfe, ein sorry, dass ich jetzt erst antworte.
So wirklich verstehe ich das nicht und ich kann auch nicht auf normalen Weg die letzte Zeile einer Inteligenten Tabelle löschen.
Wahrscheinlich ist der IQ der Tabelle einfach höher als meiner, wenn sie sich so wehrt ;-).
Ich rolle das feld jetzt aber mal von hinten auf und poste dir mal Stück für Stück den ganzen und versuche mal ein bissel zu erklären was ich wo und warum gemacht habe. Aber bitte nicht lachen, wie schon mal gesagt, bis auf den Makrorekorder und hier und da mal ein Codeschnippsel bin ich nicht wirklich der VBA könner.
Und ich entschuldige mich schon jetzt für die Wall of Text.
los ging es hier (
Application.ScreenUpdating = False
Dim lngSpalte As Long
Dim wksZiel As Worksheet
Set wksZiel = Sheets("import")
With wksZiel
lngSpalte = .Cells(6, Columns.Count).End(xlToLeft).Column
If Application.CountA(.Columns(lngSpalte)) > 0 Then lngSpalte = lngSpalte + 1
End With
Range("TDiFirma[nName]").Select
Selection.Copy
wksZiel.Cells(5, lngSpalte).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("import").Select
Ich will will mir eine selectierte Spalte vom Tabellenblatt TDIFirma auf das Tabelenblatt import kopieren.
Alles so weit so gut und funktioniert bis auf ein Detail auch ganz gut.
Leider ist das Detail, das er wie bei meinem Problem am Anfang die erste leere Zeile nicht erkennt und es direkt danaben einfügt.
Daraufhin habe ich versucht, aus dem Wertefilter ein Textfilter zu machen und follgende Zeile in die darauffolgende Zeile abgeändert.
If Application.CountA(.Columns(lngSpalte)) > 0 Then lngSpalte = lngSpalte + 1
If Application.CountA(.Columns(lngSpalte)) = "" Then lngSpalte = lngSpalte + 1
leider ohne Erfolg.
Daher habe ich das Spiel einfach umgedreht versucht, das er sofern auf A4 in import (wo normal die Überschrift steht) kein inhalt ist einfach auf A5 eine tabelle einfügt und den Code wie follgt mit einer kleinen Schleife erweitert. Sie follgenden Code.
If (Sheets("import").Range("A4")) = 0 Then
'Tabelle einfügen
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A5:$A15005"), , xlNo).Name = _
"Übersicht"
Range("Übersicht[[#All],[Spalte1]]").Select
ActiveSheet.ListObjects("Übersicht").TableStyle = "TableStyleLight9"
'Tabelle Zeilenumbruch erlauben
Range("Übersicht").Select
With Selection
.WrapText = True
End With
'Zeile 2 löschen, um Zusatzzeile vom einfügen der Tabelle auszugleichen
Rows("2:2").Select
Selection.Delete Shift:=xlUp
End If
Else
' mach weiter
'...
End If
Application.ScreenUpdating = True
End Sub
Leider muss ich in der Tabelle die Range schon deffinieren und da die Inhalte auch mal etwas mehr sein können,
habe ich die Tabelle erst mal auf 15.000 Zeilen festgelegt, was die Tabelle aber auch sehr Riesig macht.
Hinzu kommt, das beim einfügen der Tabelle auch noch eine Zeile eingefügt wird, um die Überschrift auszugleichen, was ich nicht geändert bekomme.
Daher lasse ich danach einfach zeile 2 löschen, damit das einfügen bei den weiteren Spalten ohne Probleme funktioniert.
Nun habe ich follgenden Code gefunden, der mir hilft die leeren Zeilen zu löschen und auch super funktioniert.
Sub Schaltfläche3_Klicken()
'Zeile mit wert xxxx löschen
'** Ermittlung der letzten Zeile in Spalte A
lz = Cells(Rows.Count, 1).End(xlUp).Rows.Row
'** Durchlauf aller Zeilen
For t = lz To 5 Step -1 'Zählung rückwärts bis Zeile 2
'Abfragen, ob in der ersten Spalte der Buchstabe "x" steht
If Cells(t, 1).Value = "" Then
Rows(t).Delete Shift:=xlUp
End If
Next t
End Sub
Das Problem hier ist aber, dass er bei 15k Zeilen sehr lange braucht.
Daher wollte ich einfach nur die letzte Zeile suchen und beim ersten Durchgang vom Erstellen der Tabelle, einfach die letzte Zeile mit Inhalt suchen und pauschal x zeilen löschen.
mfg auch Marco ;-)
|