Hilfe bei Arbeitsmappe > sortieren
Ingo
ich habe einen Fehler in meiner Arbeitsmappe. Wer kann mir helfen? Daten aus Userform werden in Tabelle geschrieben und sollen dort nach Datum sortiert werden. Zunächst hat es ganz gut geklappt, dann steht plötzlich ein älteres Datum vor einem jüngeren etc. Ausserdem werden Doppelte Eingaben nicht mehr angezeigt. Ich komme alleine nicht weiter. Ich schicke die Datei im Anhang vielleicht hat ja jemand den richtigen Code für mich. Habe gerade gemerkt, dass die Datei 470 kb hat und nicht hochgeladen werden kann, was kann ich tun? Ich habe mal die "zusammen gesuchten" Codes unten eingefügt.
Vielen Dank im voraus
Ingo
Private Sub CommandButton1_Click()
Set frm = userform1
Sheets("Erfassung").Activate
'letzte belegte Zelle in Tabelle finden
Range("A65536").End(xlUp).Offset(1, 0).Select
With frm
ActiveCell.Value = .TextBox1.Value
ActiveCell.Offset(0, 1).Value = .TextBox2.Value
ActiveCell.Offset(0, 2).Value = .ComboBox1.Value
ActiveCell.Offset(0, 3).Value = .TextBox4.Value
ActiveCell.Offset(0, 4).Value = .TextBox5.Value
ActiveCell.Offset(0, 5).Value = .ComboBox2.Value
ActiveCell.Offset(0, 6).Value = .TextBox7.Value
End With
'Optionsfelder auswerten
If OptionButton1.Value = True Then
ActiveCell.Offset(0, 7).Value = "1"
Else
If OptionButton2.Value = True Then
ActiveCell.Offset(0, 8).Value = "1"
Else
If OptionButton3.Value = True Then
ActiveCell.Offset(0, 9).Value = "1"
End If
End If
End If
If OptionButton4.Value = True Then
ActiveCell.Offset(0, 10).Value = "1"
Else
If OptionButton5.Value = True Then
ActiveCell.Offset(0, 11).Value = "1"
Else
If OptionButton6.Value = True Then
ActiveCell.Offset(0, 12).Value = "1"
End If
End If
End If
End Sub
Private Sub Label7_Click()
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub OptionButton1_Click()
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub TextBox7_Change()
End Sub
Sub userform_initialize()
'userform1.Caption = _
'ActiveSheet.Parent.BuiltinDocumentProperties("Company")
'letzte Zeile aus Erfassung in Textbox schreiben> Textbox1=Format(Sheets("Erfassung").Cells(Rows.Count,1).End(xlup),"DD.MM.JJJJ")
TextBox8 = Format(Sheets("Erfassung").Cells(Rows.Count, 1).End(xlUp), "DD.MM.yyyy")
'Sortierung nach Eintragen in Erfassung:
With Sheets("Erfassung")
.Range("A2").Sort Key1:=.Range("A3"), Order1:=xlAscending, Header:=xlYes
End With
'With Sheets("Erfassung")
'.Range("A1").Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=x2Yes 'Order1:=xlAscending, Header:=x2Yes
'End With
End Sub
Private Sub CommandButton2_Click()
Unload Me
'UserForm1.Hide
On Error GoTo fehlerm
Sheets("Eingabe").Activate
Exit Sub
fehlerm:
MsgBox "Die Tabelle gibt es nicht in der Mappe!"
End Sub
Private Sub CommandButton3_Click()
Dim tb As Object
For Each tb In userform1.Controls
If TypeName(tb) = "TextBox" Then tb.Text = ""
Next tb
End Sub
Private Sub TextBox1_Enter()
HintergrundFärben
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
HintergrundZurücksetzen
End Sub
Private Sub TextBox2_Enter()
HintergrundFärben
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
HintergrundZurücksetzen
End Sub
Private Sub HintergrundFärben()
Me.ActiveControl.BackColor = RGB(255, 0, 0)
End Sub
Private Sub HintergrundZurücksetzen()
Me.ActiveControl.BackColor = RGB(255, 255, 255)
End Sub
Private Sub TextBox1_afterUpdate()
If Not IsDate(TextBox1) Then
MsgBox "Kein gültiges Datum!", vbCritical, "Falsches Datum"
Exit Sub
End If
If Len(TextBox1.Value)
TextBox1 = Format(TextBox1, "dd/mm/yyyy")
Exit Sub
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(TextBox4.Text)
MsgBox "Die Klasse muss mindestens 1 Stelle aufweisen!"
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(TextBox6.Text) = 0 Then Exit Sub
If IsNumeric(TextBox6.Text) Then
MsgBox "Sie müssen einen Namen eingeben!"
Cancel = True
End If
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(TextBox3.Text) = 0 Then Exit Sub
If IsNumeric(TextBox3.Text) Then
MsgBox "Sie müssen einen Namen eingeben!"
Cancel = True
End If
End Sub
Private Sub UserForm1_Activate()
Label1.Caption = ThisWorkbook.Sheets(1).Range("A1").Text
Label2.Caption = ThisWorkbook.Sheets(1).Range("B1").Text
Label3.Caption = ThisWorkbook.Sheets(1).Range("C1").Text
Label4.Caption = ThisWorkbook.Sheets(1).Range("D1").Text
Label5.Caption = ThisWorkbook.Sheets(1).Range("E1").Text
Label6.Caption = ThisWorkbook.Sheets(1).Range("F1").Text
Label7.Caption = ThisWorkbook.Sheets(1).Range("g1").Text
Label8.Caption = ThisWorkbook.Sheets(1).Range("h1").Text
End Sub
Private Sub UserForm_Click()
End Sub