Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

neue lfd.Nr berechnen

Betrifft: neue lfd.Nr berechnen von: Stephan
Geschrieben am: 10.09.2020 13:29:34

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

Betrifft: AW: neue lfd.Nr berechnen
von: Matthias L
Geschrieben am: 10.09.2020 13:56:31

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

Betrifft: AW: neue lfd.Nr berechnen
von: Stephan
Geschrieben am: 10.09.2020 14:19:09

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.

Betrifft: neues Unterprojekt
von: Matthias L
Geschrieben am: 10.09.2020 14:43:33

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

Betrifft: AW: neues Unterprojekt
von: Stephan
Geschrieben am: 10.09.2020 15:21:43

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 ???

Betrifft: ok, dann so ...
von: Matthias L
Geschrieben am: 10.09.2020 15:32:38

Hallo

https://www.herber.de/bbs/user/140175.xlsm

Gruß Matthias

Betrifft: AW: ok, dann so ...
von: Stephan
Geschrieben am: 10.09.2020 16:02:56

Matthias, du bist ein Genie :-)

Perfekt!

Betrifft: Danke für die Rückmeldung :-) owT
von: Matthias L
Geschrieben am: 10.09.2020 16:07:06



Betrifft: Korrektur ...
von: Matthias L
Geschrieben am: 10.09.2020 14:09:51

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


Betrifft: AW: neue lfd.Nr berechnen
von: Daniel
Geschrieben am: 10.09.2020 16:06:30

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

Beiträge aus dem Excel-Forum zum Thema "neue lfd.Nr berechnen"