Anzeige
Archiv - Navigation
792to796
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
792to796
792to796
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Erweiterung - Löschen von Zeilen

Erweiterung - Löschen von Zeilen
24.08.2006 09:34:28
Zeilen
Dank eurer Hilfe habe ich folgendes Makro, um zwei Bereiche zu vergleichen und Zeilen dabei entsprechen einzufügen. Nun kann es sein, dass der Datenbereich in beiden Blöcken mit 0-Werten oder auch Leerzeilen versehen ist und diese sollten nach der Ausführung des u.g. Makros gleich mit gelöscht werden.
Bedingung ist, dass in B-E und H-K entweder 0 oder Leer ist. Ist in einem der Teile ein Wert, muss die Zeile bleiben, ansonsten soll die ganze Zeile gelöscht werden.
Hier das bisherige Makro:

Sub Ergaenzen()
Dim Erg() As Variant, OrgA() As Variant, OrgG() As Variant
Dim ErgZ As Long, zA As Long, zG As Long
ErgZ = 1
zA = 1
zG = 1
OrgA = Range("A3:E" & Range("A65536").End(xlUp).Row)
OrgG = Range("G3:K" & Range("E65536").End(xlUp).Row)
ReDim Erg(UBound(OrgA, 1) + UBound(OrgG, 1), 10)
Do Until zA > UBound(OrgA) Or zG > UBound(OrgG)
Select Case OrgA(zA, 1)            'A
Case Is = OrgG(zG, 1)            ' A = G
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zA = zA + 1
zG = zG + 1
Case Is > OrgG(zG, 1)            ' A > G
For j = 1 To 5
Erg(ErgZ, j) = OrgG(zG, j)
Erg(ErgZ, j + 5) = OrgG(zG, j)
Next j
zG = zG + 1
Case Else                         ' A < G
For j = 1 To 5
Erg(ErgZ, j) = OrgA(zA, j)
Erg(ErgZ, j + 5) = OrgA(zA, j)
Next j
zA = zA + 1
End Select
ErgZ = ErgZ + 1
Loop
Application.ScreenUpdating = False
Range("A3:K" & ErgZ + 2).Delete
For zA = 1 To ErgZ - 1
For j = 1 To 5
Cells(zA + 2, j) = Erg(zA, j)
Cells(zA + 2, j + 6) = Erg(zA, j + 5)
Next j
Next zA
Application.ScreenUpdating = True
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Erweiterung - Löschen von Zeilen
24.08.2006 12:07:17
Zeilen
Hallo Thorsten,
füge am Ende des Makros vor dem " Application.ScreenUpdating = True" folgende Zeilen ein (ungetestet!!):

'Leere Zeilen löschen
For zA = ErgZ - 1 To 1 Step -1
Anzahl = 0 'Anzahl 0-Werte und Leerzellen
For J = 2 To 5
'Spalten B-E prüfen
If Cells(zA + 2, J) = 0 Or IsEmpty(Cells(zA + 2, J)) Then Anzahl = Anzahl + 1
'Spalten H-K prüfen
If Cells(zA + 2, J + 6) = 0 Or IsEmpty(Cells(zA + 2, J + 6)) Then Anzahl = Anzahl + 1
If Anzahl < (J - 1) * 2 Then Exit For 'eine Zelle  hat Eintrag <> 0
Next J
If Anzahl = 8 Then Rows(zA + 2).Delete
Next zA

Gruß
Franz
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige