AW: Zellen vergleichen und löschen (Makro)
17.01.2011 20:13:53
fcs
Hallo David,
ich hab die Prozedur nochmals angepasst.
Die zu löschenden Zeilen werden zunächst in eine Range-Variablen gesammelt und dann in einer Aktion gelöscht.
Zusätzlich werden während der Löschaktionen die Bildschirmaktualisierung und Ereignismakros deaktiviert und der Berechnungsmodus auf Manuell gesetzt, um die Makroausführung zu beschleunigen.
Die Rechenzeit sollte jetzt bei einem einigermaßen flotten Rechner bei unter einer Minute sein.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim rng As Range, rngLoeschen As Range, StatusCalc As Long
Dim objWs As Worksheet, lngJ As Long, objWsAll As Worksheet
Dim sSpalteH As String, sSpalteI As String
If Me.ComboBox1.ListIndex > -1 Then
Set rng = Sheets("Master").Range("Liste").Find(Me.ComboBox1.Text, lookat:=xlWhole)
If Not rng Is Nothing Then
If rng.Offset(0, 1) = Me.TextBox1.Text Then
intC = 0
If rng.Offset(0, 2) "" Then
'Alle Blätter außer Übersicht ausblenden
For Each objWs In Me.Parent.Worksheets
If objWs.Name "Übersicht" Then objWs.Visible = xlSheetVeryHidden
Next
'Blätter mit Zugriff für Name einblenden
For lngJ = 2 To 6
With rng.Offset(0, lngJ)
If .Text "" Then
With Sheets(.Text)
.Visible = xlSheetVisible
.Activate
End With
End If
End With
Next
Set objWsAll = Worksheets("all_data")
sSpalteH = rng.Offset(0, 7).Text
sSpalteI = rng.Offset(0, 8).Text
With objWsAll
With Application
StatusCalc = .Calculation
If StatusCalc xlCalculationManual Then .Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.StatusBar = "Tabelle ""all_data"" wird aufbereitet"
End With
If sSpalteH = rng.Text Then
'Spalten AC und AF mit Wert in Spalte H vergleichen
For lngJ = Application.WorksheetFunction.Max( _
.Cells(.Rows.Count, 29).End(xlUp).Row, _
.Cells(.Rows.Count, 32).End(xlUp).Row) To 2 Step -1
If .Cells(lngJ, 29).Text = sSpalteH Or .Cells(lngJ, 32).Text = sSpalteH Then
'do nothing
Else
If rngLoeschen Is Nothing Then
Set rngLoeschen = .Cells(lngJ, 1)
Else
Set rngLoeschen = Application.Union(rngLoeschen, .Cells(lngJ, 1))
End If
End If
Next
Else
'Spalten AG mit Wert in Spalte I vergleichen
For lngJ = .Cells(.Rows.Count, 33).End(xlUp).Row To 2 Step -1
If .Cells(lngJ, 33).Text = sSpalteI Then
'do nothing
Else
If rngLoeschen Is Nothing Then
Set rngLoeschen = .Cells(lngJ, 1)
Else
Set rngLoeschen = Application.Union(rngLoeschen, .Cells(lngJ, 1))
End If
End If
Next
End If
If Not rngLoeschen Is Nothing Then
rngLoeschen.EntireRow.Delete
End If
With Application
If StatusCalc .Calculation Then .Calculation = StatusCalc
.ScreenUpdating = False
.EnableEvents = False
.StatusBar = False
End With
End With
Else
For Each objWs In Me.Parent.Worksheets
objWs.Visible = xlSheetVisible
Next
End If
Else
intC = intC + 1
If intC