Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Terminplanung
#1
Hallo zusammen

Ich würde gerne die angehängte Liste soweit optimieren, dass folgendes passiert:
Wird der Status in Spalte F per Dropdown-Liste auf Status "Vorprojekt" gesetzt, soll es im 2. Tabellenblatt "Kapa-Übersicht" einen Eintrag auf der nächsten freien Zeile erstellen mit dem Projektname gemäss Spalte B.
Zusätzlich soll anhand des vorgängig eingetragenen Datums in Spalte G ein Vorlage-Zeitstrahl auf dem 2.Tabellenblatt eingefügt werden. Dieser beginnend ab gleichem Datum wie eingetragen im 1. Tabellenblatt.

Ich habe versucht, das soweit abzubilden wie es aussehen könnte.

Aktuell ist mein Hauptproblem, dass ich nicht weiss nach welchen Schlüsselwörter ich hierfür suchen muss um ein Makro zu finden und anpassen zu können.

Hat jemand ein paar Inputs für mich nach welchen Wörtern ich suchen müsste oder hat allenfalls schon einen möglichen Code?
Verwende Office365 ProPlus mit Windows10, sollte dies noch relevant sein.

Vielen Dank für eure Hilfe 
Gruss Paul


.xlsm   Kapa Auslastung Architektur TEST.xlsm (Größe: 61,18 KB / Downloads: 13)
Antwortento top
#2
Wenn Du noch keine Idee für ein Makro hast, könntest Du ja auch eine .xlsx einstellen. Dann besorgen wir das hier, und müssen uns nicht infizieren.
Antwortento top
#3
Hi,

deinen Code durch den Ersetzen.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long, rng As Range

If Target.Column = 6 Then
  If Target.Cells.Count = 1 Then
    With Sheets("Kapa-Übersicht")
      Select Case Target.Value
        Case "Vorprojekt"
          Set rng = .Range("3:3").Find(Target.Offset(, 1).Value, , LookIn:=xlValues, lookat:=xlWhole)
            If Not rng Is Nothing Then
               j = .Cells(Rows.Count, 1).End(xlUp).Row + 1
               .Cells(j, 1).Value = Target.Offset(, -4).Value
               .Cells(j, rng.Column).Resize(1, 15).Interior.Color = RGB(204, 255, 204)
               Set rng = Nothing
            Else
               MsgBox ("Datum nicht gefunden.")
            End If
      End Select
    End With
  Else
     MsgBox ("Es wurde mehr als eine Zell geändert. Die Aktion wird Rückgängig gemacht")
     Application.EnableEvents = False
     Application.Undo
     Application.EnableEvents = True
  End If
End If
Gruß Elex
[-] Folgende(r) 1 Benutzer sagt Danke an Elex für diesen Beitrag:
  • Fuxxli
Antwortento top
#4
(06.07.2020, 11:22)LCohen schrieb: Wenn Du noch keine Idee für ein Makro hast, könntest Du ja auch eine .xlsx einstellen. Dann besorgen wir das hier, und müssen uns nicht infizieren.

Ups macht Sinn.. Sorry dafür.
Hatte bereits ein Makro drin für die Zellformatierung (Farbe) je nach Projektstand.

(06.07.2020, 12:24)Elex schrieb: Hi,

deinen Code durch den Ersetzen.

Gruß Elex

Hallo Elex


Vielen Dank für deine Hilfe  17 Das sieht schon mal sehr gut aus.
Ich werde versuchen darauf aufzubauen und Beschriftungen und allenfalls verschiedene Farben für den Balken einzufügen.

Falls es nicht klappt melde ich mich gerne nochmals hier  17

Gruss Paul
Antwortento top
#5
Hallo Elex

Vielen herzlichen Dank nochmals für deine Hilfe.
Ich konnte nun auf deiner Basis, weitere eingefärbte Zellen hinzufügen und diese entsprechend beschriften  18


Gruss und einen schönen Abend
Antwortento top
#6
Hallo zusammen

Nun passiert folgendes:
Auf dem ersten Tabellenblatt kann ich aus einer Dropdownliste den Case "Vorprojekt" wählen, anschliessend erstellt es mir auf dem Tabellenblatt "Kapa ab Vorprojekt" einen Eintrag mit dem entsprechenden eingefärbten und beschrifteten Zellen. Das funktioniert soweit auch super.

Gerne würde ich aber noch die Funktion einbauen, dass wenn man in der Dropdownliste auf Absage geht, dass es mir den Eintrag wieder löscht. Sprich nach der Zelle mit dem Projektname suchen und Zeile löschen. Dachte ich kann es irgendwie umbauen, hatte es mal soweit, dass es mir eine Zeile löscht aber auf der Hauptseite  Dodgy der untere Teil des Codes ist angedacht für die Löschung, ist jedoch in der jetzigen Form nicht brauchbar da ich nicht weiterkomme.

Dropdownliste ist in Spalte F und der Projektname ist in Spalte B. Auf dem 2. Tabellenblatt "Kapa ab Vorprojekt" findet man den Projektname wieder in Spalte A.
Ich nehme an, dass ich den Code von Elex nicht ganz richtig interpretiere und daher die Zelle nicht finde bzw. fehlt mir dann die Kenntnis die gefundene Zelle zu aktivieren um die Zeile löschen zu können. Im unteren Teil findet ihr den Code um die Löschung zu machen bzw. meinen Versuch...

Ist es zudem möglich nebst der eigentlichen Zeile auch die darunterliegende zu löschen? Habe jeweils eine Leerzeile drin um die einzelnen Projekte optisch etwas zu trennen.

Und das ganz grosse Kino wäre wenn ich zuerst eine Prüfung hätte ob bereits ein solcher Eintrag erstellt wurde --> falls ja Fehlermeldung "Projekt bereits erfasst", falls nein Code zur Erstellung des Eintrages ausführen.

Ich hoffe jemand kann mir hier weiterhelfen. Versuche mich nun seit ein paar Stunden daran und habe noch nicht wirklich den Durchblick erhalten. Ich werde sicherlich gewisse Schritt falsch interpretieren...

Vielen Dank für eure Hilfe oder Inputs  19

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long, rng As Range

If Target.Column = 6 Then
  If Target.Cells.Count = 1 Then
    With Sheets("Kapa ab Vorprojekt")
      Select Case Target.Value
        Case "Vorprojekt"
          Set rng = .Range("3:3").Find(Target.Offset(, 1).Value, , LookIn:=xlFormulas, lookat:=xlWhole)
            If Not rng Is Nothing Then
               j = .Cells(Rows.Count, 1).End(xlUp).Row + 2
               .Cells(j, 1).Value = Target.Offset(, -4).Value
               .Cells(j, rng.Column).Resize(1, 30).Interior.Color = RGB(204, 255, 255)
               .Cells(j, rng.Column).Value = "Vorprojektphase"
               .Cells(j, rng.Column + 30).Resize(1, 50).Interior.Color = RGB(204, 255, 204)
               .Cells(j, rng.Column + 30).Value = "Projektierungsphase"
               .Cells(j, rng.Column + 80).Resize(1, 50).Interior.Color = RGB(255, 255, 153)
               .Cells(j, rng.Column + 80).Value = "Bewilligungsphase"
               .Cells(j, rng.Column + 123).Value = "Bewilligung"
               .Cells(j, rng.Column + 130).Resize(1, 70).Interior.Color = RGB(0, 204, 255)
               .Cells(j, rng.Column + 130).Value = "Ausführungsplanung"
               .Cells(j, rng.Column + 200).Value = "BAUSTART"
               Set rng = Nothing
            Else
               MsgBox ("Datum nicht gefunden.")
            End If
      End Select
    End With
  Else
     MsgBox ("Es wurde mehr als eine Zelle geändert. Die Aktion wird rückgängig gemacht")
     Application.EnableEvents = False
     Application.Undo
     Application.EnableEvents = True
  End If
  End If
 
If Target.Column = 6 Then
  If Target.Cells.Count = 1 Then
    With Sheets("Kapa ab Vorprojekt")
      Select Case Target.Value
        Case "Absage"
          Set rng = .Range("A:A").Find(Target.Offset(, -4).Value, , LookIn:=xlValues, lookat:=xlWhole)
               ActiveCell.EntireRow.Delete
               
               Set rng = Nothing
            Else
               MsgBox ("Projekt nicht gefunden.")
            End If
      End Select
    End With
  Else
     MsgBox ("Es wurde mehr als eine Zelle geändert. Die Aktion wird rückgängig gemacht")
     Application.EnableEvents = False
     Application.Undo
     Application.EnableEvents = True
  End If
  End If
 
Antwortento top
#7
Hi

sollte so klappen.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long, rng As Range, Meldung As Long

If Target.Column = 6 Then
  If Target.Cells.Count = 1 Then
    With Sheets("Kapa ab Vorprojekt")
      Select Case Target.Value
     
       Case "Vorprojekt"
          If WorksheetFunction.CountIf(.Range("A:A"), Target.Offset(, -4).Value) > 0 Then 'Test ob schon Vorhanden
             MsgBox "Projekt schon vorhanden"
          Else
           Set rng = .Range("3:3").Find(Target.Offset(, 1).Value, , LookIn:=xlFormulas, lookat:=xlWhole)
             If Not rng Is Nothing Then
               j = .Cells(Rows.Count, 1).End(xlUp).Row + 2
               .Cells(j, 1).Value = Target.Offset(, -4).Value
               .Cells(j, rng.Column).Resize(1, 30).Interior.Color = RGB(204, 255, 255)
               .Cells(j, rng.Column).Value = "Vorprojektphase"
               .Cells(j, rng.Column + 30).Resize(1, 50).Interior.Color = RGB(204, 255, 204)
               .Cells(j, rng.Column + 30).Value = "Projektierungsphase"
               .Cells(j, rng.Column + 80).Resize(1, 50).Interior.Color = RGB(255, 255, 153)
               .Cells(j, rng.Column + 80).Value = "Bewilligungsphase"
               .Cells(j, rng.Column + 123).Value = "Bewilligung"
               .Cells(j, rng.Column + 130).Resize(1, 70).Interior.Color = RGB(0, 204, 255)
               .Cells(j, rng.Column + 130).Value = "Ausführungsplanung"
               .Cells(j, rng.Column + 200).Value = "BAUSTART"
               Set rng = Nothing
             Else
               MsgBox ("Datum nicht gefunden.")
             End If
          End If
         
       Case "Absage"
          Set rng = .Range("A:A").Find(Target.Offset(, -4).Value, , LookIn:=xlFormulas, lookat:=xlWhole)
            If Not rng Is Nothing Then
               Meldung = MsgBox(Target.Offset(, -4).Value & " löschen?", vbYesNo)
               If Meldung = 6 Then
                  rng.Resize(2).EntireRow.Delete
               End If
            End If
      End Select
    End With
  Else
     MsgBox ("Es wurde mehr als eine Zelle geändert. Die Aktion wird rückgängig gemacht")
     Application.EnableEvents = False
     Application.Undo
     Application.EnableEvents = True
  End If
End If
End Sub
Gruß Elex
[-] Folgende(r) 1 Benutzer sagt Danke an Elex für diesen Beitrag:
  • Fuxxli
Antwortento top
#8
Hallo Elex

Vielen vielen Dank.
Du bist der Hammer  18
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste