VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmBereinigung 
   Caption         =   "Bereinigungsformular"
   ClientHeight    =   4035
   ClientLeft      =   30
   ClientTop       =   420
   ClientWidth     =   6555
   OleObjectBlob   =   "frmBereinigung.frx":0000
   StartUpPosition =   1  'Fenstermitte
End
Attribute VB_Name = "frmBereinigung"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdAbbrechen_Click()
Unload Me
End Sub

Private Sub cmdStart_Click()

Dim lngZeile As Long
Dim strWarnung As String
Dim strAntwort As String
Dim lngGeloescht As Long
Dim lngErsteZeile As Long
Dim lngLetzteZeile As Long
Dim lngSpalte As Long
Dim datStartzeit As Date
Dim datStoppzeit As Date

lblFertig.Visible = False
lblZeit.Visible = False
lblGeloeschteZeilen.Visible = False

' Überprüfung der Eingabedaten

If Not IsNumeric(txtErsteZeile.Value) Then
   MsgBox "Bitte geben Sie eine Zahl für die Startzeile ein!"
   txtErsteZeile.SetFocus
   Exit Sub
End If

If Not IsNumeric(txtLetzteZeile.Value) Then
   MsgBox "Bitte geben Sie eine Zahl für die Stoppzeile ein!"
   txtLetzteZeile.SetFocus
   Exit Sub
End If

lngErsteZeile = CLng(txtErsteZeile)
lngLetzteZeile = CLng(txtLetzteZeile)
lngSpalte = Columns(CStr(txtSpalte)).Column

If lngLetzteZeile < lngErsteZeile Then
   MsgBox "Die Startzeile muss vor der Stoppzeile liegen!"
   txtErsteZeile.SetFocus
   Exit Sub
End If

' Warnungen

strWarnung = "Haben Sie eine Sicherungskopie Ihrer Daten angelegt?"
strAntwort = MsgBox(strWarnung, vbYesNo + vbDefaultButton2)
If strAntwort = vbNo Then Exit Sub

strWarnung = "Auf dem Arbeitsblatt '" & ActiveSheet.Name & "'" & vbCrLf & _
             "werden die Zeilen " & Str(lngErsteZeile) & " bis " + _
             Str(lngLetzteZeile) & " durchsucht." & vbCrLf + _
             "Alle Zeilen mit leeren Zellen in der " & Str(lngSpalte) + _
             ". Spalte" & vbCrLf & "werden gelöscht." & vbCrLf & _
             "Ist das WIRKLICH Ok?"
strAntwort = MsgBox(strWarnung, vbYesNo + vbDefaultButton2)
If strAntwort = vbNo Then Exit Sub

datStartzeit = Now()
lngGeloescht = 0

' **********************************************************************
' zur Beschleunigung:

Application.ScreenUpdating = False            'Bildschirmaktualisierung deaktivieren
Application.Calculation = xlCalculationManual 'automatische Berechnung deaktivieren

' *****************************************************************

' Das Problem besteht darin, dass mehrere leere Zeilen aufeinander folgen
' können. Lässt man die Schleife jetzt von OBEN nach UNTEN herunter laufen
' und haben z.B. die Zeilen 7,8 und 9 Leerzellen, dann wird als Erstes
' Zeile 7 gelöscht. Anschließend ist aber die bisherige Zeile 8 die Zeile 7.
' Die Schleife läuft aber weiter und untersucht die jetzige Zeile 7 (ehe-
' mals 8!) nicht mehr.
' Also müsste, nachdem die Zeile 7 als leer erkannt wurde, geschaut
' werden, ob die nächste Zeile (die ja jetzt wieder die Nummer 7 hat) auch
' leer ist. Wenn ja, dann wird sie gelöscht und die alte Zeile 9 wird zur
' neuen Zeile 7... usw.

' Um diese Problematik zu umgehen, läuft die Schleife von UNTEN nach OBEN!
' Sind dann z.B. die Zeilen 7, 8 und 9 leer, so wird als Erstes die Zeile 9
' als leer erkannt und gelöscht. Dann macht die Schleife korrekt bei Zeile 8
' weiter!

' als Do-Until-Schleife

'lngZeile = lngLetzteZeile
'Do Until lngZeile = lngErsteZeile
'   If Cells(lngZeile, lngSpalte).Value = "" Then
'      Rows(lngZeile).Delete
'      lngGeloescht = lngGeloescht + 1   'nur für die Statistik erforderlich
'   End If
'   lngZeile = lngZeile - 1
'Loop

' oder als For-Next-Schleife

' Schleife zum Löschen der Zeilen mit Leerzellen

For lngZeile = lngLetzteZeile To lngErsteZeile Step -1
   If Cells(lngZeile, lngSpalte).Value = "" Then
      Rows(lngZeile).Delete
      lngGeloescht = lngGeloescht + 1   'nur für die Statistik erforderlich
   End If
Next
      
' Ergebnisanzeige

lblFertig.Visible = True
lblZeit.Visible = True
lblGeloeschteZeilen.Visible = True
      
datStoppzeit = Now()
lblZeit.Caption = "Verbrauchte Zeit:" & Chr(13) & _
                  Format(datStoppzeit - datStartzeit, "hh:mm:ss")
lblGeloeschteZeilen.Caption = lngGeloescht & " Zeilen gelöscht"

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Cells(lngErsteZeile, lngSpalte).Activate
cmdAbbrechen.SetFocus

End Sub

Private Sub txtSpalte_Change()
Dim lngSpalte As Long
Dim lngLetzteZeile As Long

On Error Resume Next

If txtSpalte = "" Then
    Call Eingabefelder_sperren
    Exit Sub
End If

' Ermittlung der Spaltennummer aus dem Spaltenbuchstaben

lngSpalte = Columns(CStr(txtSpalte)).Column

If Err.Number <> 0 Then
    ' Wurde kein gültiger Spaltenbuchstabe eingegeben?
    Call Eingabefelder_sperren
    MsgBox "Bitte geben Sie einen gültigen Wert für die Spaltenbezeichnung ein!"
    Exit Sub
Else
    ' Ist die Spalte komplett leer?
    If Application.WorksheetFunction.CountA(Range(txtSpalte & ":" & txtSpalte)) = 0 Then
        MsgBox "Die Spalte " & txtSpalte & " ist leer!"
        Call Eingabefelder_sperren
        Exit Sub
    Else
        Call Eingabefelder_freigeben
        ' Erste Zeile mit Daten ermitteln
        txtErsteZeile = "1"
        If ActiveSheet.Cells(1, lngSpalte) = "" Then _
           txtErsteZeile = ActiveSheet.Columns(lngSpalte).End(xlDown).Row
        lngLetzteZeile = Rows.Count
        ' Letzte Zeile mit Daten ermitteln
        If Cells(lngLetzteZeile, lngSpalte) <> "" Then
           txtLetzteZeile = lngLetzteZeile
        Else
           txtLetzteZeile = Cells(lngLetzteZeile, lngSpalte).End(xlUp).Row
        End If
   End If
End If

End Sub

Private Sub Eingabefelder_sperren()

txtErsteZeile = ""
txtErsteZeile.Enabled = False

txtLetzteZeile = ""
txtLetzteZeile.Enabled = False

cmdStart.Enabled = False

txtSpalte.SetFocus

End Sub

Private Sub Eingabefelder_freigeben()
txtErsteZeile.Enabled = True
txtLetzteZeile.Enabled = True
cmdStart.Enabled = True
End Sub

Private Sub UserForm_Activate()
Call Eingabefelder_sperren
txtSpalte.SetFocus
lblFertig.Visible = False
lblZeit.Visible = False
lblGeloeschteZeilen.Visible = False
End Sub


