Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1780to1784
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

neue lfd.Nr berechnen

neue lfd.Nr berechnen
10.09.2020 13:29:34
Stephan
Hallo VBA Profis,
brauch mal eure Hilfe, habe zwar schon einiges an schnippel zusammen, doch irgenwie klappt das nicht ganz und geht bestimmt viel einfacher.
Habe wie in der Beispieldatei ein Spalte mit LaufendeNr im Format "1,00; 2,00"
nun möchte ich über eine Schaltfläche "Neues Projekt" einfach ein neues Projekt defnieren.
--- neue Zeile vor Zeile 5 mit der Laufenden Nummer 6,00.
Als zweite Schaltfläche "Neues Unterprojekt" soll nun zum Projekt der aktiven Zelle ein neues Unterprojekt angelegt werden.
aktive Zelle z.B. "D8" oder "F8" = lfd.Nummer 3,01 oder "C9" = lfd.Nummer 3,00
--- neue Zeile vor Zeile 5 mit der Laufenden Nummer 3,03 (max vom Projekt + 0,01)
Die logic soll sein, es soll eine Zeile mit einem neuen Unterprojekt bezogen auf das aktuell markierte Projekt eingefügt werden.
Wenn die aktive Zeile ein aktuelles Unterprojekt darstellt soll auch hier ein neues Unterprojet eingefügt werden.
Hoffe ich habe mich einigermasen verständlich ausgedrückt.
Gruß
Stephan
https://www.herber.de/bbs/user/140171.xlsx

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: neue lfd.Nr berechnen
10.09.2020 13:56:31
Matthias
Hallo
für das neue Projekt so:
If IsNumeric(Range("C5")) Then
Rows(5).Insert Shift:=xlDown
Range("C5") = Range("C6") + 1
Range("D5") = "Projekt " & CLng(Range("C5"))
End If
Fürs neue Unterprojekt sind noch Fragen offen.
Was wenn die Zelle mit:
Projekt 3, Unterprojekt 3.01 markiert ist
und
Projekt 3, Unterprojekt 3.02
schon vorhanden ist.
Du schreibst ja:
soll nun zum Projekt der aktiven Zelle ein neues Unterprojekt angelegt werden.
Gruß Matthias
AW: neue lfd.Nr berechnen
10.09.2020 14:19:09
Stephan
Hallo Matthias,
Vilen Dank für Deine Hilfe …...
du schreibst:
Was wenn die Zelle mit:
Projekt 3, Unterprojekt 3.01 markiert ist
und
Projekt 3, Unterprojekt 3.02
schon vorhanden ist.

Es soll immer ein neues Unterprojekt angelegt werden, also 3.03.
Anzeige
neues Unterprojekt
10.09.2020 14:43:33
Matthias
Hall,
dann schlage ich vor das höchste Unterprojekt vorher zu markieren, sonst müsste man immer das höchste Unterprojekt neu ermitteln.
Dann könnstest Du das so lösen:
If IsNumeric(Cells(ActiveCell.Row, 3)) Then
Rows(ActiveCell.Row).Insert Shift:=xlDown
Cells(ActiveCell.Row, 3) = Cells(ActiveCell.Row + 1, 3) + 0.01
Cells(ActiveCell.Row, 4) = "Projekt " & CLng(Cells(ActiveCell.Row + 1, 3)) & ", Unterprojekt "  _
& CDbl(Cells(ActiveCell.Row, 3))
End If
Gruß Matthias
AW: neues Unterprojekt
10.09.2020 15:21:43
Stephan
Hallo Matthias,
genau das ist das Problem, die Datensätze sind nach Eingabezeitpunkt sortiert, der neueste immer in Zeile 5. Somit komme die natürlich ganz durcheinander (mehrer 100) und ich wollte genau das mit der Ermittlung des max Unterprojekt + 0,01 lösen.
-- Cursor ist z.B. auf eine Zeile 11
-- nun nim den Wert aus Zeile 11 Spalte "C" (z.B. 3,01)
-- nun Filter in dieser Spalte nach der Ganzahl (hier die 3) und stell den maximalen Eintrag fest (z.B. 3,03)
-- addiere 0,01 hinzu
-- und schreibe den Wert in die Zelle "C5"
Vielleicht ist es auch einen anderen Ansatz, die laufendeNummer des Hauptprojekts in einer Spalte, und in einer anderen Spalte der Zähler des Unterprojekts, vielleicht wird's dann einfacher.
Gruß
Stephan
Sieht so eigentlich easy aus, aber hierzu die Formel finden ?
Anzeige
AW: ok, dann so ...
10.09.2020 16:02:56
Stephan
Matthias, du bist ein Genie :-)
Perfekt!
Danke für die Rückmeldung :-) owT
10.09.2020 16:07:06
Matthias
Korrektur ...
10.09.2020 14:09:51
Matthias

If IsNumeric(Range("C5")) Then
Rows(5).Insert Shift:=xlDown
Range("C5") = CInt(Range("C6")) + 1
Range("D5") = "Projekt " & Range("C5")
End If

AW: neue lfd.Nr berechnen
10.09.2020 16:06:30
Daniel
Hi
folgenden Code zum erstellen eines neuen Projekts:
Dim PNr As Long
PNr = Int(WorksheetFunction.Max(Columns(3))) + 1
Rows(5).Insert
Cells(5, 3).Value = PNr
Cells(5, 4).Value = "Projekt " & PNr

folgender Code zum erstellen eines neuen Unterprojekts:
Dim PNr As Double
PNr = Int(Cells(ActiveCell.Row, 3)) + 1
With WorksheetFunction
If PNr > .Max(Columns(3)) Then
PNr = .Max(Columns(3))
Else
PNr = .Large(Columns(3), .Rank(PNr, Columns(3)) + 1)
End If
End With
PNr = PNr + 0.01
Rows(5).Insert
Cells(5, 3) = PNr
Cells(5, 4) = "Projekt " & Int(PNr) & ", Unterprojekt " & Replace(PNr, ",", ".")

die Sortierung ist egal, dh die Projekte und Unterprojekte können auch wild durcheinander stehen.
welches Unterprojekt du beim Einfügen eines neuen Unterprojekts ausgewählt hast ist auch egal.
Einzige Bedingung ist, dass die Hauptprojekte durchgehend und ohne Lücken nummeriert sind.
dh du darfst nachträglich keine Hauptprojekte löschen.
Sollte das möglich sein dürfen, müsste man den Else-Teil im IF nochmal mit einer Schleife erweitern und den Suchwert solange erhöhen, bis es einen Treffer gibt.
Gruß Daniel
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige