Zeile markieren

Private Sub CommandButton6_Click() 'Datensatz ändern Application.ScreenUpdating = False Dim lng As Long Dim Treffer As Range Dim i As Integer On Error Resume Next lng = frmDaten.ListBox1.Column(8) Sheets("DATEN").Activate If Me.TextBox4.Value = "" Then Me.TextBox4.Value = TextBox7.Value End If Set Treffer = DATEN.Columns(1).Find(What:=Me.TextBox1.Value, _ LookAt:=xlWhole) If Treffer Is Nothing Then lng = Range("A65536").End(xlUp).Offset(1, 0).Row Else i = MsgBox("Dieser Satz wurde bereits erfasst! Überschreiben?", _ vbYesNo + vbQuestion) If i = 6 Then lng = Treffer.Row Else Exit Sub End If End If With frmDaten Cells(lng, 1).Value = .TextBox1.Value * 1 Cells(lng, 2).Value = CDate(TextBox2.Text) Cells(lng, 3).Value = .TextBox3.Value Cells(lng, 4).Value = .TextBox4.Value Cells(lng, 5).Value = .TextBox5.Value * 1 Cells(lng, 6).Value = .TextBox6.Value * 1 'Listbox aktualisieren i = .ListBox1.ListIndex .ListBox1.Column(0, i) = .TextBox1.Value .ListBox1.Column(1, i) = .TextBox2.Value .ListBox1.Column(2, i) = .TextBox3.Value .ListBox1.Column(3, i) = .TextBox4.Value .ListBox1.Column(4, i) = .TextBox5.Value .ListBox1.Column(5, i) = .TextBox6.Value End With Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim RaBereich As Range Set RaBereich = Range("I:I, K:K") If Not Intersect(Range(Target.Address), RaBereich) Is Nothing Then frmCalendar0.Show Set RaBereich = Nothing End Sub

Hi Frank,
hier mal eine neue Version deines Codes - das mit dem Select ist eingebaut:


Option Explicit
Private Sub CommandButton6_Click()                 ' Datensatz ändern
Dim lngZ As Long
Dim rngF As Range
Dim ii As Integer
'   Application.ScreenUpdating = False   ' nach dem Test aktivieren
lngZ = ListBox1.Column(8)
If TextBox4.Value = "" Then TextBox4.Value = TextBox7.Value
With Sheets("DATEN")
Set rngF = .Columns(1).Find(What:=TextBox1.Value, _
LookAt:=xlWhole)
If rngF Is Nothing Then
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
Else
ii = MsgBox("Dieser Satz wurde bereits erfasst! Überschreiben?", _
vbYesNo + vbQuestion)
If ii = 6 Then lngZ = rngF.Row Else Exit Sub
End If
.Cells(lngZ, 1).Value = TextBox1.Value * 1
.Cells(lngZ, 2).Value = CDate(TextBox2.Value)
.Cells(lngZ, 3).Value = TextBox3.Value
.Cells(lngZ, 4).Value = TextBox4.Value
.Cells(lngZ, 5).Value = TextBox5.Value * 1
.Cells(lngZ, 6).Value = TextBox6.Value * 1
ii = ListBox1.ListIndex                      ' Listbox aktualisieren
ListBox1.Column(0, ii) = TextBox1.Value
ListBox1.Column(1, ii) = TextBox2.Value
ListBox1.Column(2, ii) = TextBox3.Value
ListBox1.Column(3, ii) = TextBox4.Value
ListBox1.Column(4, ii) = TextBox5.Value
ListBox1.Column(5, ii) = TextBox6.Value
Application.EnableEvents = False             ' Zeile auswählen
.Activate
.Rows(lngZ).Select
Application.EnableEvents = True
End With
Application.ScreenUpdating = True
End Sub

Gelöscht habe ich die furchtbare Zeile "On Error Resume Next".
Sie führt nur dazu, dass du danach nichts von einem Fehler mitbekommst.
Da können die dümmsten Sachen passieren...
Und noch ein Vorschlag für ein kürzeres Worksheet_SelectionChange:


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("I:I, K:K")) Is Nothing Then frmCalendar0.Show
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile markieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread