ich habe mal meine Frage wie kann ich Zwei (Private Sub Worksheet_Change(ByVal Target As Range) Funktionen in einem Cod Fenster (Tabelle 1)ausführen
für gute Ideen bin ich sehr gerne offen
https://www.herber.de/bbs/user/152474.xlsm
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngRow As Long
Dim objRange As Range, objCell As Range
If Target.Column = 5 And Target.Row > 1 Then
lngRow = Target.Row
Application.EnableEvents = False
Cells(lngRow, 1).Value = TextBox1.Text
Cells(lngRow, 2).Value = TextBox2.Text
Cells(lngRow, 3).Value = TextBox3.Text
Application.EnableEvents = True
Else
Set objRange = Intersect(Target, Columns(4))
If Not objRange Is Nothing Then
Application.EnableEvents = False
For Each objCell In objRange
objCell.Offset(0, 23) = IIf(IsEmpty(objCell.Value), Empty, Now)
Next
Application.EnableEvents = True
End If
End If
End Sub
Gruß
Private Sub TextBox1_Change()
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngRow As Long
Dim objRange As Range, objCell As Range
If Target.Column = 5 And Target.Row > 1 Then
lngRow = Target.Row
Application.EnableEvents = False
Cells(lngRow, 1).Value = TextBox1.Text
Cells(lngRow, 2).Value = TextBox2.Text
Cells(lngRow, 3).Value = TextBox3.Text
Application.EnableEvents = True
Else
Set objRange = Intersect(Target, Columns(4))
If Not objRange Is Nothing Then
Application.EnableEvents = False
For Each objCell In objRange
objCell.Offset(0, 23) = IIf(IsEmpty(objCell.Value), Empty, Now)
Next
Application.EnableEvents = True
End If
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngRow As Long
Dim objRange As Range, objCell As Range
If Target.Column = 5 And Target.Row > 1 Then
lngRow = Target.Row
Application.EnableEvents = False
TextBox1.Text = Format$(Date, "dd.mm.yyyy")
Cells(lngRow, 1).Value = TextBox1.Text
Cells(lngRow, 2).Value = TextBox2.Text
Cells(lngRow, 3).Value = TextBox3.Text
Application.EnableEvents = True
Else
Set objRange = Intersect(Target, Columns(4))
If Not objRange Is Nothing Then
Application.EnableEvents = False
For Each objCell In objRange
objCell.Offset(0, 23) = IIf(IsEmpty(objCell.Value), Empty, Now)
Next
Application.EnableEvents = True
End If
End If
End Sub
Gruß
Private Sub Worksheet_Change(ByVal Target As Range)
Dim z, s
z = Target.Row: s = Target.Column
If s = 5 And z >= 2 Then
Cells(z, 1) = Me.TextBox1
Cells(z, 2) = Me.TextBox2
Cells(z, 3) = Me.TextBox3
ElseIf s = 4 And Target.Count = 1 Then
Target.Offset(, 23) = IIf(Len(Target) > 0, Now, "")
End If
End Sub
Hier MIT Datei:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 5 And Target.Row > 1 Then Cells(Target.Row, 1).Resize(, 3) = Array(TextBox1, TextBox2, TextBox3)
If Target.Column = 4 And Target.Count = 1 Then Target.Offset(, 23) = IIf(Len(Target) > 0, Now, "")
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen