Zeile Einfügen mit Bedingung
MarkusMatthias
Hallo zusammen,
es gibt ein kleines Excelproblem, an dem ich aktuell tatsächlich verzweifle.
Ich habe eine Tabelle, in der ich die Arbeitsaufträge eintrage und dokumentiere. Die Tabelle wird von einer Person beginnend mit der ersten Zeile befüllt. In der Spalte L kann zwischen drei Optionen zur Eintragung gewählt werden: Gültig, Abgelehnt, Nachbesserung.
Je nach Auswahl der Rückmeldung soll dann für die Zeile folgendes passieren:
1. Rückmeldung (Spalte L): „Gültig“: Message-Box mit Hinweis, dass jetzt Spalten N bis Y zu befüllen sind“
2. Rückmeldung (Spalte L): „Abgelehnt“: Message-Box mit Aufforderung zur Eintragung einer Begründung. Diese wird dann in die nächste Spalte (M) geschrieben. Da die restlichen Spalten nicht mehr befüllt werden müssen, werden diese ausgegraut.
3. Rückmeldung (Spalte L):
Teil 1 => „Nachbesserung“: Message-Box mit Aufforderung zur Eintragung einer Begründung. Diese wird dann in die nächste Spalte (M) geschrieben. Da die restlichen Spalten nicht mehr befüllt werden müssen, werden diese ausgegraut.
Teil 2 => Zudem soll nun eine neue Zeile eingefügt werden (direkt unter der aktiven Zeile (in dem Beispiel zwischen ldf. Nr. 1 und lfd. Nr. 2)), in der die Allgemeinen Angaben (Spalte A bis Spalte E) direkt übernommen werden.
Ich habe das ganze bis jetzt in einer Schleife als Makro erstellt und kann dieses per Knopfdruck aktivieren. Ich möchte aber eigentlich, dass direkt nach der Eintragung/Auswahl der Rückmeldung (Spalte L) für die Zeile die Bedingungen (siehe oben) umgesetzt werden. Somit bin ich mir gar nicht sicher, ob ich denn wirklich eine Schleife für das Vorgaben benötige oder ob die Umsetzung anders funktioniert.
Ich bin für Tipps sehr dankbar.
Viele Grüße
Bisheriger Code:
Public Sub RueckmeldungfuerSpalte()
Dim n As Integer
For n = 14 To 100
'Ablehnung
If Cells(n, 12).Value = "Abgelehnt" Then
Begründung_Ablehnung = InputBox("Bitte geben Sie eine kurze Begründung für die Ablehnung an")
Cells(n, 13).Value = Begründung_Ablehnung
Range(Cells(n, 14), Cells(n, 25)).Select
With Selection.Interior
.Pattern = xlUp
.PatternThemeColor = xlThemeColorDark1
.ColorIndex = xlAutomatic
.TintAndShade = 0
.PatternTintAndShade = -0.499984740745262
End With
'Nachbesserung
ElseIf Cells(n, 12).Value = "Nachbesserung" Then
Begründung_Nachbesserung = InputBox("Bitte geben Sie eine kurze Begründung für die Nachbesserung an")
Cells(n, 13).Value = Begründung_Nachbesserung
Cells(n + 1, 1).Select
Range(Selection, Selection.End(xlToRight)).EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cells(n, 1), Cells(n, 5)).Select
Selection.Copy
Range(Cells(n + 1, 1), Cells(n + 1, 5)).Select
ActiveSheet.Paste
Range(Cells(n, 14), Cells(n, 25)).Select
With Selection.Interior 'Befehl: Spalten N bis Y wieder umfärben in grau
.Pattern = xlUp
.PatternThemeColor = xlThemeColorDark1
.ColorIndex = xlAutomatic
.TintAndShade = 0
.PatternTintAndShade = -0.499984740745262
End With
'Gültig
ElseIf Cells(n, 12).Value = "Gültig" Then
MsgBox "Bitte die weitere Spalten (Spalte N bis Spalte Y befüllen", vbInformation
Range(Cells(n, 14), Cells(n, 25)).Select
With Selection.Interior 'Befehl: Spalten N bis Y wieder umfärben
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range(Cells(n, 14), Cells(n, 15)).Select
With Selection.Interior 'Befehl: Spalte N und 0 in gelb färben
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.399945066682943
.PatternTintAndShade = 0
End With
End If
Next n
End Sub