Mr. Z-Buffer
Grünschnabel
Hallo,
ich versuche gerade meine ersten Gehversuche in Excel und VBA.
Folgendes Szenario ist gegeben:
In einer Arbeitsmappe habe ich eine Tabelle erstellt (damit man alle werte filtern kann).
Die Überschrift der Tabelle steht ab Zeile 2 (erste Einträge ab Zeile 3).
Die Tabelle erstreckt sich derzeit von Spalte A bis Spalte R (18 Spalten).
Die Spalten sind mit unterschiedlichen Werten gefüllt (teils Text, Teils Zahlen, teils Formeln usw).
Pro Zeile ist aber nicht jede Spalte gefüllt.
Spalte K und L gehören zusammen - genau wie Spalte M und N; O und P (in der Einen steht eine Menge und in der Anderen der Preis)
Folgende Problematik:
Sobald ein Wert in Spalte M einer Zeile (z.B. M4 [was in der Tabelle die 2. Zeile entspricht]) hinterlegt ist, soll unter dieser Zeile eine neue Zeile eingefügt werden.
In diese neue Zeile soll die komplette Zeile, in der ein Wert in M gefunden wurde, hineinkopiert und der Wert aus M4 in K5 und, der Wert aus N4 in L5 kopiert werden.
Weiterhin soll in der Fundzeile (M4 und N4) der Wert gelöscht werden.
Dies soll im Anschluss auch mit den Spalten O und P passieren.
Endergebnis:
Datensätze, welche mehr als eine Auflage haben, sollen die Auflagen und die Preise nicht mehr horizontal in einer Zeile, sondern Vertikal in mehrer Zeilen stehen.
Die Auflagen und die Preise stehen im Anschluss nicht mehr in je 3 Spalten sondern untereinander in nur noch je einer Spalte.
Mein Code sieht bis jetzt so aus (Das Suchen der Einträge und einfügen neuer Zeilen funktioniert sehr gut - okay, der Code sieht nicht sehr schön aus-
Nur möchte ich nicht Zelle für Zelle kopieren und löschen, da schreibe ich mir ja die Finger wund.:
Sub aufr()
n = 3 'Startpunkt der Suche, da sonst die Tabellenüberschrift auch kopiert werden würde
Do 'Schleifen beginn, bis ich beim letzten Eintrag der Tabelle angelangt bin
If Not Cells(n, 15).Value = Empty Then
Cells(n + 1, 15).EntireRow.Insert
Aufl3 = Cells(n, 15)
preis3 = Cells(n, 16)
Cells(n, 15) = Empty
Cells(n, 16) = Empty
Cells(n + 1, 11).Value = Aufl3
Cells(n + 1, 12).Value = preis3
End If
If Not Cells(n, 13).Value = Empty Then
Cells(n + 1, 13).EntireRow.Insert
Aufl2 = Cells(n, 13)
preis2 = Cells(n, 14)
Cells(n, 13) = Empty
Cells(n, 14) = Empty
Cells(n + 1, 11).Value = Aufl2
Cells(n + 1, 12).Value = preis2
End If
n = n + 1
Loop Until n = Range("m65536").End(xlUp).Row + 1
End Sub
Danke für die Hilfe.
Viele Grüße
Buffer
ich versuche gerade meine ersten Gehversuche in Excel und VBA.
Folgendes Szenario ist gegeben:
In einer Arbeitsmappe habe ich eine Tabelle erstellt (damit man alle werte filtern kann).
Die Überschrift der Tabelle steht ab Zeile 2 (erste Einträge ab Zeile 3).
Die Tabelle erstreckt sich derzeit von Spalte A bis Spalte R (18 Spalten).
Die Spalten sind mit unterschiedlichen Werten gefüllt (teils Text, Teils Zahlen, teils Formeln usw).
Pro Zeile ist aber nicht jede Spalte gefüllt.
Spalte K und L gehören zusammen - genau wie Spalte M und N; O und P (in der Einen steht eine Menge und in der Anderen der Preis)
Folgende Problematik:
Sobald ein Wert in Spalte M einer Zeile (z.B. M4 [was in der Tabelle die 2. Zeile entspricht]) hinterlegt ist, soll unter dieser Zeile eine neue Zeile eingefügt werden.
In diese neue Zeile soll die komplette Zeile, in der ein Wert in M gefunden wurde, hineinkopiert und der Wert aus M4 in K5 und, der Wert aus N4 in L5 kopiert werden.
Weiterhin soll in der Fundzeile (M4 und N4) der Wert gelöscht werden.
Dies soll im Anschluss auch mit den Spalten O und P passieren.
Endergebnis:
Datensätze, welche mehr als eine Auflage haben, sollen die Auflagen und die Preise nicht mehr horizontal in einer Zeile, sondern Vertikal in mehrer Zeilen stehen.
Die Auflagen und die Preise stehen im Anschluss nicht mehr in je 3 Spalten sondern untereinander in nur noch je einer Spalte.
Mein Code sieht bis jetzt so aus (Das Suchen der Einträge und einfügen neuer Zeilen funktioniert sehr gut - okay, der Code sieht nicht sehr schön aus-
Nur möchte ich nicht Zelle für Zelle kopieren und löschen, da schreibe ich mir ja die Finger wund.:
Sub aufr()
n = 3 'Startpunkt der Suche, da sonst die Tabellenüberschrift auch kopiert werden würde
Do 'Schleifen beginn, bis ich beim letzten Eintrag der Tabelle angelangt bin
If Not Cells(n, 15).Value = Empty Then
Cells(n + 1, 15).EntireRow.Insert
Aufl3 = Cells(n, 15)
preis3 = Cells(n, 16)
Cells(n, 15) = Empty
Cells(n, 16) = Empty
Cells(n + 1, 11).Value = Aufl3
Cells(n + 1, 12).Value = preis3
End If
If Not Cells(n, 13).Value = Empty Then
Cells(n + 1, 13).EntireRow.Insert
Aufl2 = Cells(n, 13)
preis2 = Cells(n, 14)
Cells(n, 13) = Empty
Cells(n, 14) = Empty
Cells(n + 1, 11).Value = Aufl2
Cells(n + 1, 12).Value = preis2
End If
n = n + 1
Loop Until n = Range("m65536").End(xlUp).Row + 1
End Sub
Danke für die Hilfe.
Viele Grüße
Buffer
Zuletzt bearbeitet: