Wie kann ich über ein Formular eine neue Zeile in eine bestimmte Zeile einfügen?

Question

Guten Tag,

ich habe eine Projektübersicht, diese enthält für jedes Projekt die Projektpase und ein von und bis Datum (und ein Ganttdiagramm). Wenn ich eine neue Phase einfügen will, möchte ich das gern über ein Formular machen. Die neue Zeile soll in Abhängigkeit von dem Projektnamen und dem Startdatum an die richtige Stelle eingefügt werden. Das Formular soll über eine Schaltfläche "neues Projekt/Phase hinzufügen" zu aktivieren sein. Die Reihenfolge der Projekte in der Statusanzeige richtet sich nach dem Eingangsdatum im Arbeitsblatt "Projektdaten". Ich habe eine Beispieldatei (mit fiktiven Daten) angelegt, muss nur rausfinden wo und wie ich die hochladen kann.

Ich möchte beispielsweise, dass das Projekt "Muschelkalk" zwischen "Seeluft" und "Rügenperle" eingefügt wird.

Ich habe schon sehr lange nichts mehr in VBA gebaut, daher wäre ich sehr Dankbar über Hilfe.

Ina

Answer 1

Hallo Ina,

zeig mal deine Datei, damit man sich was drunter vorstellen kann. Dann sehen wir weiter.

Die Datei kannst du hier im Supportnet hochladen. Ist ganz einfach.

https://supportnet.de/forum/2514808/wie-kann-ich-hier-eine-datei-hochladen-uplaoden-faq

Gruß Mr. K.

Answer 2

Hallo zusammen,

hier jetzt die Dateihttps://supportnet.de/forum/?qa=blob&qa_blobid=87108353156787835

Und zur Ergänzung, Wenn ich über den Rechtsklick eine neue Zeile einfüge, dann zerschießt es mir jedes Mal die bedingte Formatierung. Wie bekomme ich das hin, dass Formatierung gleich bleibt, auch wenn eine zusätzliche Zeile eingebaut wird. Bzw. für die neue Zeile sollen die gleichen Bedingungen gelten, wie die bereits vorhandenen.

Liebe Grüße

Ina

Answer 3

Hi Ina,

schreibe in Tabelle "Projektdaten" in F2 den Namen des Projektes, welches in Spalte B neu hinzugekommen ist und in F3 die Anzahl an Phasen die dieses Projekt beinhaltet. Dann kannst du mit folgendem Code das betreffende Projekt in Tabelle "Statusanzeige" an der richtigen Stelle einfügen:

Sub ProjektEinfuegen()
    Dim rngSuche As Range
    Dim rngStart As Range
    Dim lngLetzte As Long
    Dim intAnzahl As Integer
    Dim intAnzahl2 As Integer
    Dim rngZelle As Range
    Set rngStart = Columns(2).Find(Range("F2"), lookat:=xlWhole)  '<== Zelladresse anpassen!!
    If Not rngStart Is Nothing Then
        With Worksheets("Statusanzeige (3)")
            Set rngSuche = .Columns(1).Find(rngStart.Offset(-1, 0).Value, lookat:=xlWhole)
            intAnzahl2 = Application.CountIf(.Columns(1), rngStart.Offset(-1, 0).Value)
            If Not rngSuche Is Nothing Then
                intAnzahl = Range("F3")  '<== Zelladresse anpassen!!
                .Range(.Cells(rngSuche.Row + intAnzahl2, 1), .Cells(rngSuche.Row + intAnzahl2 + intAnzahl - 1, 1)).EntireRow.Insert
                .Range(.Cells(rngSuche.Row + intAnzahl2, 1), .Cells(rngSuche.Row + intAnzahl + 2, 1)) = rngStart.Value
                lngLetzte = .Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Range("A7").FormatConditions(1).ModifyAppliesToRange Range(Cells(7, 1), Cells(lngLetzte, 100))
                If .Cells(rngSuche.Row + intAnzahl2, 1).FormatConditions.Count > 1 Then
                    .Range(.Cells(rngSuche.Row + intAnzahl2, 1), .Cells(rngSuche.Row + intAnzahl + 2, 1)).FormatConditions(2).Delete
                End If
                If .Cells(rngSuche.Row + intAnzahl2, 2).FormatConditions.Count > 5 Then
                    .Range(.Cells(rngSuche.Row + intAnzahl2, 2), .Cells(rngSuche.Row + intAnzahl + 2, 2)).FormatConditions(6).Delete
                End If
                If .Cells(rngSuche.Row + intAnzahl2, 3).FormatConditions.Count > 1 Then
                    .Range(.Cells(rngSuche.Row + intAnzahl2, 3), .Cells(rngSuche.Row + intAnzahl + 2, 4)).FormatConditions(2).Delete
                End If
                If .Cells(rngSuche.Row + intAnzahl2, 5).FormatConditions.Count > 6 Then
                    .Range(.Cells(rngSuche.Row + intAnzahl2, 5), .Cells(rngSuche.Row + intAnzahl + 2, 100)).FormatConditions(7).Delete
                End If
            End If
        End With
    End If
End Sub

Die Zelladressen F2 / F3 kannst du natürlich deinen Bedürfnissen anpassen.

Bis später, Karin