Hallo Forum
Ich bin ein zimlicher Anfänger von VBA und Makros. Ich habe mir ein Excel erstellt bei welchem ich die Termine etc überwache.
Weiter habe ich ein paar soritier Makros drin.
Nun ist mein problem das beim öffnen der Datei 1x das ganze durchgechekt wird was es leider nur macht wenn ich jeweils in die zelle doppelklicke.
Worksheet_SelectionChangehabe ich auch schon ausprobiert dann kriegt VBA probleme mit dem Sortieren und hängt sich auf
Private Sub Worksheet_Change(ByVal Target As Range)
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim ProduktionsStatus, FertigGestelltAm, TageBisLieferung, Liefertermin, VerfuegbareBearbeitungsZeit, Heut, WERohmaterial, DLZ, AuftragErfasstAm
ProduktionsStatus = 27
FertigGestelltAm = 28
TageBisLieferung = 10
Liefertermin = 8
VerfuegbareBearbeitungsZeit = 11
Heut = 33
WERohmaterial = 13
DLZ = 29
AuftragErfasstAm = 7
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:AQ"), Target)
xOffsetColumn = 0
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
'Fertig gestellt am'
If Cells(Target.Row, ProduktionsStatus).Value <> "Erledigt" Then
Cells(Target.Row, FertigGestelltAm) = ""
Else
Cells(Target.Row, FertigGestelltAm) = Date$
End If
'Tage bis Lieferung'
If Cells(Target.Row, ProduktionsStatus).Value <> "Erledigt" And Cells(Target.Row, Liefertermin).Value <> "" Then
Cells(Target.Row, TageBisLieferung) = Cells(Target.Row, Liefertermin) - Cells(Target.Row, Heut)
Else
Cells(Target.Row, TageBisLieferung).Value = "---"
End If
'Tage bis Lieferung Warnung'
If Cells(Target.Row, ProduktionsStatus).Value <> "Erledigt" And Cells(Target.Row, TageBisLieferung).Value <= 0 Then
Cells(Target.Row, TageBisLieferung).Interior.Color = vbRed
ElseIf Cells(Target.Row, ProduktionsStatus).Value <> "Erledigt" And Cells(Target.Row, TageBisLieferung).Value >= 0 And Cells(Target.Row, TageBisLieferung).Value <= 4 Then
Cells(Target.Row, TageBisLieferung).Interior.Color = rgbOrange
ElseIf Cells(Target.Row, ProduktionsStatus).Value <> "Erledigt" And Cells(Target.Row, TageBisLieferung).Value >= 3 And Cells(Target.Row, TageBisLieferung).Value <= 100 Then
Cells(Target.Row, TageBisLieferung).Interior.Color = rgbGreen
End If
'Verfügbare Bearbeitungszeit'
If Cells(Target.Row, WERohmaterial).Value <> "" And Cells(Target.Row, Liefertermin).Value <> "" Then
Cells(Target.Row, VerfuegbareBearbeitungsZeit) = Cells(Target.Row, Liefertermin) - Cells(Target.Row, WERohmaterial)
Else
Cells(Target.Row, VerfuegbareBearbeitungsZeit).Value = "Angaben fehlen"
End If
'Durchlaufzeit'
If Cells(Target.Row, ProduktionsStatus).Value = "Erledigt" And Cells(Target.Row, AuftragErfasstAm).Value <> "" And Cells(Target.Row, Liefertermin).Value <> "" Then
Cells(Target.Row, DLZ) = Cells(Target.Row, FertigGestelltAm) - Cells(Target.Row, AuftragErfasstAm)
Else
Cells(Target.Row, DLZ).Value = "---"
End If
Next
Application.EnableEvents = True
End If
|