EXCEL VBA Farbcode Durchstreichen MSG BOX

[IchBinIch]

Quäl dich heut nimmer unötig weiter.

Hbs mit deiner formel auch nochmal probiert ... auch nochmal angeschrieben auf deine formel aber dann führt er ned weiter aus

Hab mich nicht gequält :32:
Es hatte aber einen Grund warum ich sagte: "Heute nicht mehr."

So geht es dann auch mit der Prüfung auf Datum in Spalte I.

Sub EinfärbenZwei()
Dim z As Long
Dim zm As Long

With Tabelle1
    zm = .Cells(Rows.Count, 1).End(xlUp).Row
    'Tabelle auf Standardformatierung zurücksetzen 
    With .Range("A5:J" & zm)
        .Interior.ColorIndex = xlNone
        .Font.Color = vbBlack
        .Font.Strikethrough = False
    End With
    
        For z = 5 To zm
        
        If .Range("H" & z).Value = "x" Then
            If IsDate(.Range("I" & z)) Then
                With .Range("A" & z, "G" & z)
                    .Interior.Color = vbRed
                    .Font.Color = vbWhite
                    .Font.Strikethrough = True
                End With
            Else
                Datum = InputBox("Geben Sie ein Datum ein:  (TT.MM.JJJJ)")
                .Range("I" & z).Value = Datum
                Ersatz = InputBox("Durch welches Formular wird das Formular ersetzt?")
                .Range("J" & z).Value = Ersatz
                With .Range("A" & z, "G" & z)
                    .Interior.Color = vbRed
                    .Font.Color = vbWhite
                    .Font.Strikethrough = True
                End With
            End If
            .Range("G" & z).Value = "ersetzt"
                
            ElseIf .Cells(z, 1).Value = .Cells(z + 1, 1).Value Then
                .Range("A" & z, "G" & z).Interior.Color = vbRed
                .Range("G" & z).Value = "ausgelaufen"
            
            Else
                .Range("A" & z).Interior.Color = vbGreen
                .Range("B" & z).Interior.Color = vbGreen
                .Range("G" & z).Interior.Color = vbGreen
                .Range("G" & z).Value = "aktiv"
        End If
        
       Next z
End With
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 12 - mit VBAHTML 12.6.0

Gruß
Ich

[freeloader1986]

Hab mich nicht gequält :32:
Es hatte aber einen Grund warum ich sagte: "Heute nicht mehr."

So geht es dann auch mit der Prüfung auf Datum in Spalte I.

ich probier es später mal aus .... hab es jetzt mal anders gelöst ... aber ist gut, dass ich dann ma noch einen anderen ansatz sehe =)

einfach reinkopieren ohne etwas anzupassen?

[IchBinIch]

Ja.

Also einfach das "alte" "EinfärbenZwei" gegen das oben tauschen.

[freeloader1986]

Hab mich nicht gequält :32:
Es hatte aber einen Grund warum ich sagte: "Heute nicht mehr."

So geht es dann auch mit der Prüfung auf Datum in Spalte I.

läuft auch einwandfrei jetzt =)   coole sache .... fettes Danke an dich =)

ich hab es so gelöst: 

 If .Range("H" & z).Value <> "" Then

          If .Range("I" & z).Value <> "" Then GoTo weiter

einfach mit dem Sprung ...

was mir jetzt natürlich noch eingefallen ist ... aus bequemlichkeit ... :D

ein Button ... neues formular erstellen, dann eine zelle einfügen - wenn es Formular 01 schon gibt ... direkt darunter .... ansonsten am ende der Tabelle in eine neue Zeile =)

aber das ist etwas, woran ich mich erst gar nicht versuchen will :D

----------

was ich in mom via wenn funktion gelöst habe, aber vll auch einfach mit einem makro zu lösen wäre, wäre die aufsteigende nummer bei Formularen (Duplikaten)

Also Formular 1 dann in der Spalte Version 1 .... Formular 1 Version 2 ... usw. und sobald ein neues Formular kommt, dann einfach wieder bei Version 1 anfangen :D

AAAAAAAAAAAAAAAAAABER .... das sind jetzt nur noch Spielereien ... da musst du nicht extra Zeit investieren ... das sind nur Dinge, die mir jetzt noch einfallen sind =)

[IchBinIch]

Hi,

ich hatte gerade Langeweile.

Viel Spaß beim Testen :32:

Option Explicit
Sub Einfärben()
Dim z As Long
Dim zm As Long
Dim Datum As Date
Dim Ersatz As String

With Tabelle1
    zm = .Cells(Rows.Count, 1).End(xlUp).Row
    'Tabelle auf Standardformatierung zurücksetzen 
    With .Range("A5:J" & zm)
        .Interior.ColorIndex = xlNone
        .Font.Color = vbBlack
        .Font.Strikethrough = False
    End With
    
        For z = 5 To zm
        
        If .Range("H" & z).Value = "x" Then
            If IsDate(.Range("I" & z)) Then
                With .Range("A" & z, "G" & z)
                    .Interior.Color = vbRed
                    .Font.Color = vbWhite
                    .Font.Strikethrough = True
                End With
            Else
                Datum = InputBox("Geben Sie ein Datum ein:  (TT.MM.JJJJ)")
                .Range("I" & z).Value = Datum
                Ersatz = InputBox("Durch welches Formular wird das Formular ersetzt?")
                .Range("J" & z).Value = Ersatz
                With .Range("A" & z, "G" & z)
                    .Interior.Color = vbRed
                    .Font.Color = vbWhite
                    .Font.Strikethrough = True
                End With
            End If
            .Range("G" & z).Value = "ersetzt"
                
            ElseIf .Cells(z, 1).Value = .Cells(z + 1, 1).Value Then
                .Range("A" & z, "G" & z).Interior.Color = vbRed
                .Range("G" & z).Value = "ausgelaufen"
            
            Else
                .Range("A" & z).Interior.Color = vbGreen
                .Range("B" & z).Interior.Color = vbGreen
                .Range("G" & z).Interior.Color = vbGreen
                .Range("G" & z).Value = "aktiv"
        End If
        
       Next z
End With
End Sub

Sub NeuesFormular()
Dim z As Long
Dim zm As Long
Dim nForm As String
Dim Treffer As Range

With Tabelle1
    
    zm = .Cells(Rows.Count, 1).End(xlUp).Row
    nForm = InputBox("Geben Sie die neue Formularnummer ein:                 (z.B. Formular 012)")
    
    If nForm = "" Then Exit Sub
    
    Set Treffer = .Range("A5")
    
    For z = 1 To WorksheetFunction.CountIf(Columns(1), nForm)
        
        Set Treffer = Columns(1).Find(What:=nForm, After:=Treffer, _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False)
  
    Next z
    
    If z > 1 Then
        
        If MsgBox("Formular existiert bereits. Eine neue Version anlegen?", vbYesNo, "Formular existent") = vbYes Then
            Treffer.Offset(1, 0).EntireRow.Insert
            Treffer.Offset(1, 0).Value = nForm
            Treffer.Offset(1, 1).Value = Treffer.Offset(0, 1).Value + 1
            Treffer.Offset(1, 2).Select
        Else
            Exit Sub
        End If
    
    Else
        .Cells(zm + 1, 1).Value = nForm
        .Cells(zm + 1, 2).Value = 1
        .Cells(zm + 1, 3).Select
    
    End If
    
End With

End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Gruß
Ich


  Hilfe_Ich.xlsm (Größe: 20,57 KB / Downloads: 4)

Ergänzung:
Die Sache hat einen Haken:
Wenn der Anwender statt "Formular 001" "Formular001" eingibt, wird ein neues Formular angelegt.
Ich habe die Datei noch einmal neu angefügt. Hatte vergessen das neue Makro mit dem Button zu verknüpfen.

[RPP63]

Bevor Du antwortest, freeloader19:
Es gibt hier einen "Antworten"-Button, der in einem Dialog erheblich besser als der "Zitat-Antwort"-Button ist.
Eine Tapete ist bei einer Renovierung sinnvoll, ein Forum müllt sie lediglich zu.

Two Cents from Ralf

[freeloader1986]

Ergänzung:
Die Sache hat einen Haken:
Wenn der Anwender statt "Formular 001" "Formular001" eingibt, wird ein neues Formular angelegt.
Ich habe die Datei noch einmal neu angefügt. Hatte vergessen das neue Makro mit dem Button zu verknüpfen.

Das Problem hatte ich mal bei einem anderen Formular ... und das konnte ich lösen.

E gibt die Möglichkeit den text zu lesen und "" herauszufiltern. Muss mal schaun ob ich das noch auf die schnelle finde.

We meinst du das mit "neues Formular angelegt"? Du meinst, dass er nicht wie gewollt die zeile unter formular 001 einfügt und die Versionsnummer hochzählt um +1 sondern am ende der tabelle das Formular001 Version 1 einträgt?

[IchBinIch]

Probier es mal aus :32:

[freeloader1986]

Probier es mal aus :32:

Um dich noch etwas zu ärgern ..... =)


Das ganze funktioniert wieder .... AAAAAAAAABER :D

Das Formular wird direkt untendrunter eingefügt ....

Formular 001 V1
Formular 001 V2
Formular 001 V2
Formular 001 V2

Also damit es funktioniert, müsste er die Versionsnummer aufsteigend vergeben und immer an höchster Stelle weitermachen.

Also wenn es

Formular 001 V1
Formular 001 V2

bereits gibt müsste er unter drunter einfügen

Formular 001 V1
Formular 001 V2

Formular 001 V3

und damit ich ehrlich zu dir bin .... da kann ich selber auch nix mehr machen - da kann ich auch nichts mehr zusammenpfuschen :D

[IchBinIch]

Kleiner Schreibfehler - große Wirkung.
Der Fehler tritt nur bei Formular 001 auf, gelle :32:

Ändere bitte diese Zeile

Code:

Set Treffer = .Range("A5")

in

Code:

Set Treffer = .Range("A4")

Gruß
Ich