Wie diesen Code optimieren/beschleunigen?

Hi wertes Forum,
ich habe nun ein neues kleines Problem.
Ich nutze folgenden Code, um alle leere Spalten in einer bestimmten Tabelle zu löschen. Dabei darf nur der Inhalt der Tabelle und nicht die ganze Spalte gelöscht werden.
With Worksheets("Infos")
InfoRow = 22
InfoColumn = 1
Dim CleanColumn As Long
For CleanColumn = .Cells(23, Columns.Count).End(xlToLeft).Column To 4 Step -1
If .Cells(Rows.Count, CleanColumn).End(xlUp).Row = 23 Then _
Call .Range(.Cells(22, CleanColumn), .Cells(Rows.Count, CleanColumn)).Delete(Shift:=xlShiftToLeft)
Next
End With
Das Problem ist, dass die Tabellen mittlerweile etwa 150 Spalten breit und 30 Zeilen lang sind. Dies liegt daran, dass die Datenbank derart viele Variablen hat. Die meisten Aufträge nutzen davon nur etwa. 10, aber trotzdem müssen alle zur Auswahl vorhanden sein damit alle Zuordnungskombinationen funktionieren. Deshalb dauert dieser Code mittlerweile etwa 15 min bis er fertig ist. Und das ist leider etwas zu lange. Vor allem in den Fällen, in denen von den 150 Spalten nur 10 verwendet wurden.
Gibt es einen Weg den Code zu optimieren?
Ziel:
Prüfen, ob in irgendeiner Zeile unter irgendeiner Spalte der Kopfzeile ein Wert steht.
Falls es hilft: es kann nur in den Zeilen ein Wert stehen, die in der ersten Spalte einen Wert stehen haben. Denn der erste Wert einer jeden Zeile MUSS existieren. Wenn hier keiner existiert, dann sind alle Spalten dieser Zeile leer.
Vielen lieben Dank für eure Hilfe und viele Grüße
Alex

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

With Sheets("Info").UsedRange With .Rows(.Rows.Count + 1) .FormulaR1C1 = "=IF(AND(Column(RC)>3,CountA(R24C:R[-1]C)=0),1,"""")" If WorksheetFunction.Sum(.Cells) > 0 Then Intersect(.SpecialCells(xlCellTypeFormulas, 1).EntireColumn, _ .Worksheet.Range("22:" & .Row)).Delete Shift:=xlToLeft End If .ClearContents End With End With

With Sheets("Info").UsedRange With .Rows(.Rows.Count + 1) .FormulaR1C1 = "=IF(AND(Column(RC)>3,CountA(R24C:R[-1]C)=0),1,"""")" If WorksheetFunction.Sum(.Cells) > 0 Then .Worksheet.Range("22:" & .Row).Sort key1:=.Cells(1, 1), _ order1:=xlDescending, Header:=xlNo, Orientation:=2 Intersect(.SpecialCells(xlCellTypeFormulas, 1).EntireColumn, _ .Worksheet.Range("22:" & .Row)).Delete Shift:=xlToLeft End If .ClearContents End With End With

Hallo Daniel,
ja, die Zuordnung hatte ich dann schon korrekt verstanden. Aber was nicht klappt, ist dass er dann auch die zugehörige Kopfzeile mit verschiebt.
Nehmen wir mal die Beispieldatei. Hier habe ich es geändert auf

Sub Auftragsübersicht_anlegen()
Application.ScreenUpdating = False
With Worksheets("Auftragsübersicht").UsedRange
With .Rows(.Rows.Count + 1)
.FormulaR1C1 = "=IF(AND(Column(RC)>3,CountA(R3C:R[-1]C)=0),1,"""")"
If WorksheetFunction.Sum(.Cells) > 0 Then
.Worksheet.Range("3:" & .Row).Sort key1:=.Cells(1, 1), _
order1:=xlDescending, Header:=xlNo, Orientation:=2
Intersect(.SpecialCells(xlCellTypeFormulas, 1).EntireColumn, _
.Worksheet.Range("3:" & .Row)).Delete Shift:=xlToLeft
End If
.ClearContents
End With
End With
End Sub

Das funktioniert prinzipiell, aber er sortiert nur den Inhalt der Tabelle nach vorne. Die Zuordnung zur Kopfzeile geht dabei aber verloren. Er muss ja ab Zeile 1 verschieben. Ich dachte, dass ich dazu dann diese Anpassung machen müsste:

              .Worksheet.Range("1:" & .Row).Sort key1:=.Cells(1, 1), _
order1:=xlDescending, Header:=xlNo, Orientation:=2
Intersect(.SpecialCells(xlCellTypeFormulas, 1).EntireColumn, _
.Worksheet.Range("1:" & .Row)).Delete Shift:=xlToLeft

Das funktioniert aber nicht. Deshalb suche ich meinen Denkfehler und verstehe nicht so ganz, wieso das nicht klappt.

Beliebteste Forumthreads (12 Monate)

Wie diesen Code optimieren/beschleunigen?

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

286 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wie diesen Code optimieren/beschleunigen?

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

286 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread