Spalte anstatt Zeile
amintire
benötige Hilfe bei einer Code umschreibung.
Die Datei https://www.herber.de/bbs/user/74347.xls wurde aus Datenschutzgründen gelöscht
Momentan ist es so, dass bei Eingabe alle TextBoxen nebeneinander bei Klick auf Button gespeichert werden, nächste Eingabe ist nächste freie Zeile usw.
es soll aber genau umgekehrt sein, also untereinander stehen und bei neuen Eingaben dann nächste Spalte.
Habe eine Beispielmappe zur Verständlichkeit hochgeladen, ansonsten hier wäre der Code:
Private Sub TextBox1_Change()
Dim varTMP As Variant
With Tabelle1
varTMP = Application.Match(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
TextBox5.Text = .Cells(varTMP, 5).Value
TextBox6.Text = .Cells(varTMP, 6).Value
TextBox7.Text = .Cells(varTMP, 7).Value
TextBox8.Text = .Cells(varTMP, 8).Value
Else
Me.Tag = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
End If
End With
End Sub
Private Sub CommandButton1_Click()
Dim lngRow As Long
If Me.Tag "" Then
With Tabelle1
.Cells(Me.Tag, 1).Value = TextBox1.Text
.Cells(Me.Tag, 2).Value = TextBox2.Text
.Cells(Me.Tag, 3).Value = TextBox3.Text
.Cells(Me.Tag, 4).Value = TextBox4.Text
.Cells(Me.Tag, 5).Value = TextBox5.Text
.Cells(Me.Tag, 6).Value = TextBox6.Text
.Cells(Me.Tag, 7).Value = TextBox7.Text
.Cells(Me.Tag, 8).Value = TextBox8.Text
End With
Else
With Tabelle1
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngRow, 1) = TextBox1.Text
.Cells(lngRow, 2) = TextBox2.Text
.Cells(lngRow, 3) = TextBox3.Text
.Cells(lngRow, 4) = TextBox4.Text
.Cells(lngRow, 5) = TextBox5.Text
.Cells(lngRow, 6) = TextBox6.Text
.Cells(lngRow, 7) = TextBox7.Text
.Cells(lngRow, 8) = TextBox8.Text
End With
End If
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
End Sub
Lieben Gruß Amina