VBA Code Formel eintragen
13.04.2020 11:38:11
Stefan
Ich benötige mal wieder Hilfe.
Ich kopiere mit folgenden Code bei doppelklick in eine bestímmte Spalte die Zellen 1 bis 45 in einen anderen Sheet.
Siehe Case 43
Anschließend soll diese Zeile wie folgt gereinigt werden.....
Funktioniert soweit auch bis auf Offset -32.....dort soll die Formel eingetragen werden, wobei sich T8 entsprechend der Zeile wo der Doppelklick gemacht wird anpasst.
Ich hoffe ihr versteht was ich meine....
Option Explicit
Private Sub Worksheet_Activate()
AutoFilter.ApplyFilter
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lngRow As Long
Dim lngZei As Long, lngSpa As Long, ZeiTitel As Long
Dim strMsg As String
If Not Intersect(Target, Range("N4:AQ250")) Is Nothing Then
Cancel = True
Select Case Target.Column
Case 14
Cells(Target.Row, 1) = 2
Target = Now
Case 15
Cells(Target.Row, 1) = 3
Target = Now
Case 16
Cells(Target.Row, 1) = 4
Target = Now
Case 17
Target = Now
Case 18
Cells(Target.Row, 1) = 5
Target = Now
Case 43
If MsgBox("Willst du wirklich dieses Projekt ins Archiv übergeben?", _
vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then
With Worksheets("Archiv")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Target.Offset(, -42).Resize(, 45).Copy .Rows(lngRow)
'nach Übergabe Zeile löschen in Projektübersicht
'Target.EntireRow.Delete
Target.Offset(, -42) = 1
Target.Offset(, -40) = ""
Target.Offset(, -39) = ""
'Target.Offset(, -38) = ""
'Target.Offset(, -37) = ""
Target.Offset(, -36) = ""
Target.Offset(, -35) = ""
Target.Offset(, -34) = ""
Target.Offset(, -33) = "LT"
'Target.Offset(, -32).FormulaLocal = "=WENN(T8>1;T8+8/24;"")"
Target.Offset(, -31) = ""
Target.Offset(, -29) = ""
Target.Offset(, -28) = ""
Target.Offset(, -27) = ""
Target.Offset(, -26) = ""
Target.Offset(, -25) = ""
Target.Offset(, -24) = ""
Target.Offset(, -23) = ""
Target.Offset(, -22) = ""
Target.Offset(, -21) = ""
Target.Offset(, -16) = ""
Target.Offset(, -13) = ""
Target.Offset(, -12) = ""
Target.Offset(, -9) = ""
Target.Offset(, -8) = ""
Target.Offset(, -5) = ""
Target.Offset(, -4) = ""
Target.Offset(, -1) = ""
Target.Offset(, -0) = ""
End With
End If
Case 22
lngZei = Target.Row
ZeiTitel = 3 'Zeile mit den SPaltentitel
If lngZei > ZeiTitel Then
Cancel = True
'Prüfen ob Zellen ausgefüllt sind
For lngSpa = 1 To Me.UsedRange.Column + Me.UsedRange.Columns.Count - 1
Select Case lngSpa
Case 2 To 9, 12 To 16, 18, 20, 21, 31, 35, 39 'Spalten A, C bis E, G - Spalten _
_
in denen Werte _
eingegeben sein müssen - anpassen!!!
If Cells(lngZei, lngSpa).Text = "" Then
strMsg = strMsg & vbLf & Cells(ZeiTitel, lngSpa).Text
End If
Case Else
'do nothing
End Select
Next
If strMsg "" Then
MsgBox "In folgenden Feldern des Auftrages fehlen Eingaben:" & strMsg
Else
MsgBox "alle Muss-Eingaben sind vorhanden. Der Auftrag geht jetzt in die _
Produktion!" ' nur zum Testen
'hier der Code wenn alle Eingaben OK
Cells(Target.Row, 1) = 7
Target = Now
End If
End If
Case Else
'do nothing
End Select
End If
End Sub