UserForm - Suchen - Ändern - Schreiben...

Frage: In Sheet2 habe ich in Spalte A Indexnummern und in den Spalten B-D dazugehörige Informationen. Über eine UserForm würde ich nun gerne in einem Textfeld eine Indexnummer eingeben und in den anderen drei Textfeldern sollen dann die entsprechenden Werte dazu angezeigt werden.

In TextBox1 soll man nur Zahlen eingeben können.

Ist die Indexnummer nicht vorhanden, soll eine Neueingabe möglich sein. TextBox1 und TextBox2 müssen ausgefüllt sein - sonst Meldung. Dann Eingabe der Werte in die erste freie Zeile in Sheet2. Wie geht das?

Hier noch eine Beispieldatei: UserForm - Suchen - Eingabe - Ändern...

Code gehört in den Codebereich der UserForm (4 TextBoxen und 1 CommandButton):

Option Explicit
'--------------------------------------------------------------------------
' Module    : UserForm1
' Procedure : TextBox1_Change
' Author    : Case (Ralf Stolzenburg)
' Date      : 06.10.2012
' Purpose   : UserForm TextBox Search Change...
'--------------------------------------------------------------------------
Private Sub TextBox1_Change()
    Dim varTMP As Variant
    On Error GoTo Fin
    If Not Trim(TextBox1.Text) = "" Then
        With Sheet2
            varTMP = Application.Match(CLng(TextBox1.Text), .Range("A:A"), 0)
            If Not IsError(varTMP) Then
                Me.Tag = varTMP
                TextBox2.Text = .Cells(varTMP, 2).Value
                TextBox3.Text = .Cells(varTMP, 3).Value
                TextBox4.Text = .Cells(varTMP, 4).Value
            Else
                Me.Tag = ""
                TextBox2.Text = ""
                TextBox3.Text = ""
                TextBox4.Text = ""
            End If
        End With
    Else
        TextBox2.Text = ""
        TextBox3.Text = ""
        TextBox4.Text = ""
    End If
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Chr(KeyAscii) Like "[0-9]" = False Then KeyAscii = 0
End Sub
Private Sub CommandButton1_Click()
    Dim lngRow As Long
    On Error GoTo Fin
    If Trim(TextBox1.Text) <> "" And Trim(TextBox2.Text) <> "" Then
        If Me.Tag <> "" Then
            With Sheet2
                .Cells(Me.Tag, 1).Value = CLng(TextBox1.Text)
                .Cells(Me.Tag, 2).Value = TextBox2.Text
                .Cells(Me.Tag, 3).Value = TextBox3.Text
                .Cells(Me.Tag, 4).Value = TextBox4.Text
            End With
        Else
            With Sheet2
                lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(lngRow, 1) = CLng(TextBox1.Text)
                .Cells(lngRow, 2) = TextBox2.Text
                .Cells(lngRow, 3) = TextBox3.Text
                .Cells(lngRow, 4) = TextBox4.Text
            End With
        End If
            TextBox1.Text = ""
    Else
        MsgBox ("Entry incomplete!")
        TextBox1.SetFocus
    End If
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Code in ein allgemeines Modul:

Option Explicit
Sub UF_Show()
    UserForm1.Show 0
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...