Positionnummer fortschreiben wenn Inhalt gleich

Question

Hallo, ich habe folgende Tabelle.

In Zelle A1 steht die Überschrift Position
In Zelle B1 steht die Überschrift Wert
Ab Zelle B2 stehen nach unten verschiedene Werte. Diese kommen manchmal nur 1x vor und manchmal auch mehrfach. Die mehrfach vorkommenden Werte stehen hierbei immer untereinander und nicht durcheinander.

Ich möchte ein Makro schreiben, das in Zelle A2 immer den Wert 1 stehen hat. Ab Zelle A3 soll folgende Prüfung vorgenommen werden:

wenn B3=B2 dann A3=A2+1 ansonsten Zelle leer lassen.

Das Ergebnis wäre nun, dass im Falle dass wenn die Werte von z.B. B2 bis B5 gleich sind, in A2 bis A5 jeweils 1 2 3 4 5 in Zelle Spalte A erscheint.

Im Anschluss soll das Makro Spalte A abprüfen und alle Zeilen, bei denen im Zelle Spalte A ein numerischer Wert steht, löschen. Die nun verbleibenden Werte sollen entsprechend der gelöschten Zeilen, nach oben nachrutschen.

Nun beginnt Durchlauf 2. A2 hat wieder den Wert 1 und Spalte B wird gemäß o.g. Beschreibung erneut abgeprüft.

Die Schleife soll solange laufen, bis die Tabelle keine Werte mehr hat.

Kann mir bitte jemand helfen hier ein entsprechendes Makro zu schreiben mit entsprechender Beschreibung zu jedem Befehl? Alle meine bisherigen Versuche sind leider alle schief gelaufen.

Danke

Answer 1

Hallo,

am einfachsten wäre es, wenn du gleich die ganze Tabelle löschst.
Aber mal Spaß beiseite. Wenn du das wirklich so willst, wie du dein Problem beschrieben hast, dann werden ja nach und nach alle Zeilen gelöscht.

Willst du vielleicht nur die doppelten Einträge löschen?

Gruß

M.O.

Answer 2

Hi. Verständlich bei meiner Problemschilderung, dass Du das so siehst. Das was ich beschrieben habe ist nur ein Teil eines ganzen Makros.

Vielleicht ist es so für Dich nachvollziehbarer:

Die jeweiligen Positionen werden, kommen diese mehrfach vor, von 1 bis x durchnummeriert. Nun werden diese Daten durch das Makro ausgelagert und separat auf meinem Laufwerk gespeichert.

Deshalb sollen dann diese Zeilen aus der Ursprungsdatei gelöscht werden.

Wenn in der Ursprungsdatei am Ende der Schleife dann nichts mehr übrig bleibt, und das Makro damit dann auch am Ende ist, dann wäre alles genau so verlaufen, wie ich mir das vorstelle.

Klingt komisch, ist aber so

Answer 3

Hallo,

ist M.O. Dein Nick? Du hast mir schon mal bei meinem Thema geholfen mit den Verbundzellen. Vielleicht erinnerst Du Dich da noch dran.

Das was ich da jetzt machen will ist quasi eine Fortsetzung, weil ich die laufenden Nummern nicht immer manuell eintragen und die Zeilen dann manuell löschen will.

Answer 4

Hallo,

ja ich bin es, der Nick kam mir doch bekannt vor :-).

Versuch mal das folgende Makro:

Sub doppelloeschen()

Dim lngZeile As Long
Dim lngLetzte As Long
Dim lngZaehler As Long

'letzte Zeile in Spalte B ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

'in Zelle A2 den Wert 1 schreiben, falls in Spalte B2 etwas steht
If IsEmpty(ActiveSheet.Cells(2, 2)) = False Then ActiveSheet.Cells(2, 1) = 1

'Zähler auf 2 festlegen
lngZaehler = 2

'Schleife: ab Zeile 3 prüfen ob Inhalt mit Zeile 2 übereinstimmt
For lngZeile = 3 To lngLetzte
If ActiveSheet.Cells(lngZeile, 2).Value = ActiveSheet.Cells(2, 2).Value Then
ActiveSheet.Cells(lngZeile, 1) = lngZaehler
lngZaehler = lngZaehler + 1
End If
Next lngZeile

'hier kommt jetzt dein Code zum kopieren
'nur zur Verdeutlichung hier eine Messagebox eingefügt
MsgBox "Duchlauf beendet! Daten werden nun gelöscht!", 64, "Info"

'nun Zeilen durchlaufen und alle Zeilen mit nummerischen Werten löschen
'Durchlauf fängt von hinten an, da sonst nicht alle zu löschenden Zeilen gelöscht werden
For lngZeile = lngLetzte To 2 Step -1
If ActiveSheet.Cells(lngZeile, 1).Value > 0 Then ActiveSheet.Cells(lngZeile, 1).EntireRow.Delete xlShiftUp
Next lngZeile

'nun Makro für neuen Durchlauf starten, falls B2 nicht leer ist
If IsEmpty(ActiveSheet.Range("B2")) = False Then Call doppelloeschen

End Sub

Probiere das aber erst einmal in einer Testdatei aus. Das Makro vergleicht alle Zeilen ab Zeile 3 mit der Zeile 2, findet somit auch Doppel, die nicht direkt hintereinander stehen.
Wo jetzt die Messagebox steht, kannst deinen Code zum Speichern einsetzen.

Gruß

M.O.

Answer 5

Dein Makro funktioniert grundsätzlich und erfüllt das, was ich wollte. Ich habe die Codes nun deshalb in das Makro, bei dem Du mir beim letzten Mal schon geholfen hast eingefügt.

Da die Variablen Dim lngZeile As Long, Dim lngLetzte As Long und Dim lngZaehler1 As Long schon beim Thema "Zellen gleichen Inhalts verbinden" an späterer Stelle im Makro vorkommen, habe ich o.g. Variablen und alle Stellen an denen diese angesprochen werden umbenannt in:

Dim lngZeile1 As Long
Dim lngLetzte1 As Long
Dim lngZaehler1 As Long

Wenn ich jetzt den Code laufen lasse, kommt folgender Fehler:

Fehler beim Kompilieren: Mehrfachdekleration im aktuellen Gültigkeitsbereich

Makro kommt an der Stelle Dim lngletzte As Long (das ist die spätere Stelle, an der die Variablen für die Verbundzellen deklariert werden) zum Stehen

Answer 6

Hallo,

fasse die DIM-Anweisungen immer an Anfang zusammen, dann siehst du, welche Variable du ggf. mehrfach deklariert hast.

Gruß

M.O.

Answer 7

Hi,

hat jetzt alles funktioniert. Erneut: Vielen Dank für die Hilfe und für die Detailerklärung zu den einzelnen Codes.

Dieses Thema mit Variablen und Schleifen ist nicht gerade einfach. Hast Du evtl. eine Buchempfehlung, wo das einem Neuling einfach und verständlich näher gebracht wird oder hast Du das vielleicht selbst Aufschriebe, die Du mir evtl. zur Verfügung stellen kannst?

Answer 8

Hallo,

ich habe zwar ein Buch, aber nur selten reingeschaut ;-).
Im Internet findest zu viele Anleitungen, Erklärungen etc.
Zum Thema Schleifen kannst zu z.B. hier mal nachschauen: KLICK MICH!
Zu Variablen kannst du z.B. hier mal nachschauen: LINK 1, LINK 2

Auch die Online-Hilfe hilft oft weiter. Klicke mal im VBA-Editor z.B. bei der Zeile

Dim lngZeile1 As Long

in das Wort "Long" und drücke F1. Und natürlich hilft es auch, sich die Codes von Anderen anzusehen (bzgl. Aufbau, Problemlösungen etc).

Gruß

M.O.

Answer 9

Danke. Die Links sind auf jeden Fall mal wertvoll.

Die F1 Hilfe-Funktion steht unter Office2010 und 2007 scheinbar nicht zur Verfügung.