Mehrere Zeilen aus Array löschen

Sub dbReduzieren() Dim Zeile As Range Dim LöschZeilen() As Long Dim x As Long With ActiveSheet For Each Zeile In .UsedRange.Rows If Zeile.Hidden Then ReDim Preserve LöschZeilen(x) LöschZeilen(x) = Zeile.row x = x + 1 End If Next If x > 0 Then .Rows(LöschZeilen).Select End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub dbReduzieren() Dim Zeile As Range Dim rngRed As Range With ActiveSheet For Each Zeile In .UsedRange.Rows If Zeile.Hidden Then If rngRed Is Nothing Then Set rngRed = Zeile Else Set rngRed = Union(rngRed, Zeile) End If End If Next If Not rngRed Is Nothing Then rngRed.Select End With End Sub

Hallo Bernd,
kann ich keine Zeilennummern auf einmal auswählen
doch, einfach mal mit dem Recoder aufnehmen - zB. Range("4:4,7:7,10:10").Select
Dabei darf der String aber nicht länger als 256 Zeichen sein und außerdem sind String-Operationen zeitaufwendig. (Dein "Redim" übrigens auch))
Mit der Union-Methode kann man bestimmt mehr Einzelbereiche zusammenfügen als bei der oben beschriebenen, das wird aber bei mehreren 1000 Ranges sehr sehr langsam.
Bleibt also:
- entweder gleich in der Schleife (dann von hinten nach vorne) deine Zeilen zu löschen oder:
- Verwende den Spezial-Filter - da du hier die ausgeblendeten Zeilen löschen willst, ist das sicher die schnellste Methode.
Probier's einfach mal aus...
Gruß
Christian

Option Explicit Sub TestIt() Dim i&, t! Dim rngUnion As Range t = Timer With ActiveSheet For i = 1 To 6000 Step 2 If rngUnion Is Nothing Then Set rngUnion = .Rows(i) Else Set rngUnion = Union(rngUnion, .Rows(i)) End If Next If Not rngUnion Is Nothing Then rngUnion.Delete End If End With Debug.Print Timer - t End Sub

Sub TestIt() Dim i&, t!, wks As Worksheet t = Timer Application.ScreenUpdating = False Set wks = Sheets("Tabelle2") wks.Cells.Clear With ActiveSheet .Columns(1).Resize(, 2).Copy wks.Cells(1, 1) wks.Columns(1).Resize(, 2).Copy .Cells(1, 1) If .FilterMode Then .ShowAllData End With Application.ScreenUpdating = True Set wks = Nothing MsgBox Timer - t End Sub

Hallo,
das geht so nicht, dass Rangeobjekt kann kein Array verarbeiten.
Hier eine Version mit Hilfsspalte, diese wird wieder gelöscht.
Kannst mal unter xl2003 testen, funktioniert unter xl2007 recht gut.

Sub dbReduzieren()
Dim UnionRange As Range, iCalc%

With Application
    iCalc = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    
        With ActiveSheet.UsedRange
            With .Columns(.Columns.Count).Offset(0, 1) 'Hilfsspalte 
                On Error Resume Next
                 .SpecialCells(xlCellTypeVisible).FormulaR1C1 = 1 'Sichtbare Zellen belegen 
                 Set UnionRange = .SpecialCells(xlCellTypeBlanks).EntireRow 'leere Zellen merken 
                On Error GoTo 0
                .EntireColumn.Delete 'Hilfsspalte löschen 
            End With
        End With
    
    .Calculation = iCalc
    .ScreenUpdating = True
    .EnableEvents = True
End With

If Not UnionRange Is Nothing Then
    UnionRange.Select
    MsgBox "Der Bereich " & UnionRange.Address(0, 0) & " wurde selektiert"
End If
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Mehrere Zeilen aus Array löschen

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mehrere Zeilen aus Array löschen

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread