'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

Public zaehler

Public Sub del_empty_row()
Application.ScreenUpdating = False
'könnte man auch als Parameter übergeben!
A_1 = False
zaehler = 0: n = "n"

'lege Suchbereich fest
Set r = ActiveSheet.UsedRange

If A_1 Then
   l = Len(r.Address)
   pos = InStr(1, r.Address, ":")
   rtemp = "$A$1" & Right(r.Address, l - pos + 1)
   Range(rtemp).Activate
Else
   'aktiviere Suchbereich
   Range(r.Address).Activate
End If

'Schleife über alle Zeilen
For Each rn In Selection.Rows
  ar = rn.Row
  br = rn.Column
nochmal:
  'wenn erste Zelle nicht leer, dann Zeile nicht leer!
  If Not IsEmpty(Cells(ar, br)) Then GoTo inhalt
  'sonst prüfe die Zeile
  For Each cn In Selection.Columns
       bc = cn.Column
       'brich bei erster nichtleerer Zelle ab
       If Not IsEmpty(Cells(ar, bc)) Then GoTo inhalt
  Next
  'die Zeile ist leer
  Rows(ar).Delete
  zaehler = zaehler + 1
  GoTo nochmal
'Sprungmarke
inhalt:
Next
If zaehler = 1 Then n = ""
Application.ScreenUpdating = True
Application.StatusBar = zaehler & " Zeile" & n & " wurde" & n & " gelöscht!"

End Sub


Public Sub del_empty_row_a1()
Application.ScreenUpdating = False

'könnte man auch als Parameter übergeben!
A_1 = True
zaehler = 0: n = "n"

'lege Suchbereich fest
Set r = ActiveSheet.UsedRange

If A_1 Then
   l = Len(r.Address)
   pos = InStr(1, r.Address, ":")
   rtemp = "$A$1" & Right(r.Address, l - pos + 1)
   Range(rtemp).Activate
Else
   'aktiviere Suchbereich
   Range(r.Address).Activate
End If

'Schleife über alle Zeilen
For Each rn In Selection.Rows
  ar = rn.Row
  br = rn.Column
nochmal:
  'wenn erste Zelle nicht leer, dann Zeile nicht leer!
  If Not IsEmpty(Cells(ar, br)) Then GoTo inhalt
  'sonst prüfe die Zeile
  For Each cn In Selection.Columns
       bc = cn.Column
       'brich bei erster nichtleerer Zelle ab
       If Not IsEmpty(Cells(ar, bc)) Then GoTo inhalt
  Next
  'die Zeile ist leer
  Rows(ar).Delete
  zaehler = zaehler + 1
  GoTo nochmal
'Sprungmarke
inhalt:
Next
If zaehler = 1 Then n = ""
Application.ScreenUpdating = True
Application.StatusBar = zaehler & " Zeile" & n & " wurde" & n & " gelöscht!"

End Sub



Public Sub del_empty_column()
Application.ScreenUpdating = False

'könnte man auch als Parameter übergeben!
A_1 = False
zaehler = 0: n = "n"

'lege Suchbereich fest
Set c = ActiveSheet.UsedRange

If A_1 Then
   l = Len(c.Address)
   pos = InStr(1, c.Address, ":")
   ctemp = "$A$1" & Right(c.Address, l - pos + 1)
   Range(ctemp).Activate
Else
   'aktiviere Suchbereich
   Range(c.Address).Activate
End If

'Schleife über alle Zeilen
For Each cn In Selection.Columns
  ac = cn.Row
  bc = cn.Column
nochmal:
  'wenn erste Zelle nicht leer, dann Zeile nicht leer!
  If Not IsEmpty(Cells(ac, bc)) Then GoTo inhalt
  'sonst prüfe die Zeile
  For Each rn In Selection.Rows
       ar = rn.Row
       'brich bei erster nichtleerer Zelle ab
       If Not IsEmpty(Cells(ar, bc)) Then GoTo inhalt
  Next
  'die Zeile ist leer
  Columns(bc).Delete
  zaehler = zaehler + 1
  GoTo nochmal

'Sprungmarke
inhalt:
Next
If zaehler = 1 Then n = ""
Application.ScreenUpdating = True
Application.StatusBar = zaehler & " Spalte" & n & " wurde" & n & " gelöscht!"

End Sub


Public Sub del_empty_column_a1()
Application.ScreenUpdating = False

'könnte man auch als Parameter übergeben!
A_1 = True
zaehler = 0: n = "n"

'lege Suchbereich fest
Set c = ActiveSheet.UsedRange

If A_1 Then
   l = Len(c.Address)
   pos = InStr(1, c.Address, ":")
   ctemp = "$A$1" & Right(c.Address, l - pos + 1)
   Range(ctemp).Activate
Else
   'aktiviere Suchbereich
   Range(c.Address).Activate
End If

'Schleife über alle Zeilen
For Each cn In Selection.Columns
  ac = cn.Row
  bc = cn.Column
nochmal:
  'wenn erste Zelle nicht leer, dann Zeile nicht leer!
  If Not IsEmpty(Cells(ac, bc)) Then GoTo inhalt
  'sonst prüfe die Zeile
  For Each rn In Selection.Rows
       ar = rn.Row
       'brich bei erster nichtleerer Zelle ab
       If Not IsEmpty(Cells(ar, bc)) Then GoTo inhalt
  Next
  'die Zeile ist leer
  Columns(bc).Delete
  zaehler = zaehler + 1
  GoTo nochmal

'Sprungmarke
inhalt:
Next
If zaehler = 1 Then n = ""
Application.ScreenUpdating = True
Application.StatusBar = zaehler & " Spalte" & n & " wurde" & n & " gelöscht!"

End Sub


Public Sub del_rows_n_cols()
  del_empty_row
  z1 = zaehler
  n1 = "n"
  n = "n"
  If z1 = 1 Then n1 = ""
  del_empty_column
  Application.StatusBar = z1 & " Zeile" & n1 & " und " & zaehler & " Spalte" & n & " wurde" & n & " gelöscht!"
End Sub

Public Sub del_rows_n_cols_a1()
  del_empty_row_a1
  z1 = zaehler
  n1 = "n"
  n = "n"
  If z1 = 1 Then n1 = ""
  del_empty_column_a1
  If zaehler = 1 Then n = ""
  Application.StatusBar = z1 & " Zeile" & n1 & " und " & zaehler & " Spalte" & n & " wurde" & n & " gelöscht!"
End Sub