Tabelle nach Leezellen durchsuchen

Question

Hallo,

ich habe eine Tabelle in deren Zeile 1 die Überschriften stehen.
Die erste Spalte ist mit den Artikelnummern belegt, in den übrigen 20 Spalten stehen Artikelkenndaten, die aber leider nicht vollständig sind.
Ich suche einen Code, der die Liste durchsucht und die Artikelnummern protokolliert, die unvollständige Angaben haben.
Das Protokoll soll also die Artikelnummer und die Spaltenüberschrift haben.
Hat jemand eine Idee??
Gruß

Answer 1

warum nicht Autofilter?

Gruß hajo

Answer 2

Hallo Andreas,

hier mal mein Vorschlag:

Sub leerzellen()

Dim i, spalte, zeile, zz As Long
Dim bExists As Boolean
Dim Blattname, Blattaktiv As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Name des aktiven Arbeitsblattes wird in Variable geschrieben
Blattaktiv = ActiveSheet.Name

'Name des Arbeitsblattes, in das die Daten der gefundenen Leerzellen geschrieben werden
Blattname = "AuswertungLeer"

' Testen ob ein Arbeitsblatt mit dem Blattnamen existiert
For i = 1 To Sheets.Count
If Sheets(i).Name = Blattname Then
bExists = True: Exit For
End If
Next i

If bExists Then
' ... wenn ja: Inhalte des Arbeitsblattes löschen
With ThisWorkbook.Worksheets(Blattname)
.Range(.Cells(1, 1), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, .UsedRange.SpecialCells(xlCellTypeLastCell).Column)).ClearContents
End With
Else
' ... wenn nein: ein solches Blatt erstellen.
'Neues Blatt wird am Ende eingefügt
Worksheets.Add After:=Worksheets(Worksheets.Count)
'Neues Blatt benennen
ActiveSheet.Name = Blattname
End If

'Schleife für Prüfen auf Leerzellen
For zeile = 2 To Sheets(Blattaktiv).Cells(Rows.Count, 1).End(xlUp).Row

'Variable für Ausgabespalte setzen
spalte = 2

'Prüfen ob im Bereich der aktuellen Zeile in Spalten 2 bis 20 eine leere Zelle vorhanden ist
If Application.WorksheetFunction.CountBlank(Range(Sheets(Blattaktiv).Cells(zeile, 2), Sheets(Blattaktiv).Cells(zeile, 20))) > 0 Then
'Falls ja, Inhalt aus Spalte 1 in das Auswertungsblatt schreiben
' dazu wird der Zeilenzähler hochgesetzt
zz = zz + 1
Sheets(Blattname).Cells(zz, 1) = Sheets(Blattaktiv).Cells(zeile, 1)
'jetzt die gefundenen Leerzellen durchlaufen
For Each zelle In Sheets(Blattaktiv).Rows(zeile).SpecialCells(xlCellTypeBlanks)
Sheets(Blattname).Cells(zz, spalte) = Sheets(Blattaktiv).Cells(1, zelle.Column) 'Spaltenüberschrift der leeren Zelle schreiben
spalte = spalte + 1 'Zähler für Spalte um 1 erhöhen
Next zelle
End If

Next zeile

'Auf Auswertungsblatt wechseln
Sheets(Blattname).Activate

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Gruß

M.O.

Answer 3

Hallo M.O.

super, wirklich ein tolles Programm!!!!
Ich habe allerdings einen Fehler in einer Zeile, die kein leeres Element enthält. Sicher muss da die Abfrage noch auf diese Möglichkeit angepasst werden...
Gruß
Andreas

Answer 4

Hallo Andreas,

bei meinen Test hat das Makro tadellos funktioniert, auch wenn es Zeilen gibt, in denen keine Leerzelle vorhanden ist.

Durch die Zeile

If Application.WorksheetFunction.CountBlank(Range(Sheets(Blattaktiv).Cells(zeile, 2), Sheets(Blattaktiv).Cells(zeile, 20))) > 0 Then

wird schon geprüft, ob in der betreffenden Zeile zwischen den Spalten B und T leere Zeilen vorhanden sind.

Wie sieht denn der Fehler aus (und ggf. wie die Daten)?

Gruß

M.O.

Answer 5

Hallo,

der Fehler "Keine Zellen gefunden" tritt bei
For Each zelle In Sheets(Blattaktiv).Rows(zeile).SpecialCells(xlCellTypeBlanks)
auf.
Die Testdatei ist relativ einfach, 10 Zeilen, 4 Spalten. Der Fehler kommt bei Andreas9, wo jede Spalte belegt ist.

Name Regal1 Regal2 Regal3 Regal4
Andreas1 d g d
Andreas2 f
Andreas3 g u f
Andreas4 h f
Andreas5 u g f
Andreas6 u z
Andreas7 j b u
Andreas8 k u
Andreas9 o j u h
Andreas10 l k

Answer 6

Hallo M.O.

ich habe die Musterdatei in Zeile 9 noch einmal so geändert, dass dort eine Leerzelle vorkommt, dann funktioniert der Code einwandfrei.
Ohne Leerzelle erfolgt wieder die Fehlermeldung. Irgendwie scheint die Bedingung
If Application.WorksheetFunction.CountBlank(Range(Sheets(Blattaktiv).Cells(zeile, 2), Sheets(Blattaktiv).Cells(zeile, 20))) > 0 Then
diesen Fall nicht abzudecken. Kann es daran liegen, dass die Zellen neben Zahlen- auch Textvariablen enthalten?
Gruß
Andreas

Answer 7

Hallo Andreas,

ich kann den Fehler nicht nachvollziehen. Bei mir funktioniert die Auswertung ohne Fehler, auch wenn eine Zeile keine Leerzellen enthält. Dabei spielt es keine Rolle ob Zahlen oder Text enthalten sind.
Lade doch mal deine Musterdatei, in der der Fehler auftritt hoch, z.B. hier, und poste den entsprechenden Link,

Gruß

M.O.

Answer 8

Guten Morgen,

http://www.file-upload.net/download-8893321/FehlDaten.xlsm.html
Die Musterdatei steht unter Tabelle1.
Danke für deine Hilfe!
Gruß
Andreas

Answer 9

Hallo Andreas,

der Fehler kommt daher, da du in deiner Mustertabelle nur 4 Spalten überprüfst.

Durch die Zeile

If Application.WorksheetFunction.CountBlank(Range(Sheets(Blattaktiv).Cells(zeile, 2), Sheets(Blattaktiv).Cells(zeile, 20))) > 0 Then

wird geprüft, ob in den Spalten 2 bis 20 Leerzellen enthalten sind, was bei deiner Beispieldatei zutrifft, da du ja nur 5 Spalten hast.
Da danach aber keine Leerzellen in dem Bereich deiner Daten gefunden wird, kommt es zu der Fehlermeldung.

Wenn du die Zeile in

If Application.WorksheetFunction.CountBlank(Range(Sheets(Blattaktiv).Cells(zeile, 2), Sheets(Blattaktiv).Cells(zeile, 5))) > 0 Then

änderst, funktioniert der Code ohne Fehler :-).

Gruß

M.O.

Answer 10

Hallo M.O.

dein Code funktioniert einwandfrei...
Ich wollte allerdings noch eine kleine Variante einbauen, hat aber bei mir nicht geklappt.
Und zwar möchte ich im konkreten Fall prüfen, ob bis zur Spalte 12 Leerzellen vorkommen. Die Leerzellen, die ab der Spalte13 ggf. vorkommen sind uninteressant. Das Protokoll soll dann aber auch nur die Leerzellen aufnehmen bis zur Spalte 12, aktuell werden alle Leerzellen dokumentiert...
Hat du da noch einen Tipp?
Gruß
Andreas