UF zeigt Daten verkehrt an
16.01.2009 12:24:00
Wolfgang
die untenstehenden Codes stammen aus einer Anwendung für Adressdatenverwaltung. In bestimmten Bereichen konnte ich eine Anpassung vornehmen. Was aber gar nicht läuft, ist, dass bei Suchen die 8 Textboxes auch wieder richtig "beschickt" werden. Hier erscheint der Name nicht mehr, sondern in Name steht dann der Vorname usw. - Es wird also insgesamt um eine Box verschoben, so dass bei Ändern auch die geänderten Daten in eine falsche Zelle gelangen. Was mache ich verkehrt? - Wäre für jede Hilfestellung sehr dankbar.
Herzliche Grüße
Wolfgang
Dim Meine_Zeile As String
Private Sub UserForm_Initialize()
TextBox13.SetFocus
End Sub
Private Sub UserForm_Activate()
With ListBox1
.ColumnWidths = "60;90;90;90;0"
.ColumnCount = 5
End With
Sheets("Daten").Select
Range("A1").Select
End Sub
Private Sub ListBox1_Click()
Dim rng As Range
Dim IntC As Integer
Dim lngR As Long
With ListBox1
If .ListCount = 0 Then Exit Sub
If .List(.ListIndex, 0) = "" Then Exit Sub
lngR = CLng(.List(.ListIndex, 4))
Meine_Zeile = Rows(Sheets("Daten").Cells(lngR, 1).Row).Address
For IntC = 1 To 8
Controls("TextBox" & IntC) = Sheets("Daten").Cells(lngR, IntC + 1).Text
Next
End With
TextBox13.SetFocus
End Sub
Private Sub CommandButton1_Click() ' Suchen
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
If Len(Trim(TextBox13)) = 0 Then Exit Sub
ListBox1.Clear
For IntC = 1 To 8
Controls("TextBox" & IntC) = ""
Next
ReDim vtmp(0)
With Sheets("Daten")
Set rng = .Range("A:H").Find(What:=TextBox13, Lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
ListBox1.AddItem .Cells(rng.Row, 3)
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(rng.Row, 4)
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(rng.Row, 7)
ListBox1.List(ListBox1.ListCount - 1, 3) = .Cells(rng.Row, 2)
ListBox1.List(ListBox1.ListCount - 1, 4) = rng.Row
End If
Set rng = .Range("A:H").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address strFirst
End If
End With
If ListBox1.ListCount > 0 Then
ListBox1.ListIndex = 0
Else
ListBox1.AddItem "Kein Eintrag!"
End If
Set rng = Nothing
End Sub
Private Sub CommandButton2_Click() ' Ändern
Dim intZ As Integer
Dim durchsuchen, finden As Range
Set durchsuchen = Sheets("Daten").Range("A2:B" & _
Sheets("Daten").Range("A65536").End(xlUp).Row)
For Each finden In durchsuchen
If finden.Text = TextBox1.Text Then
intZ = finden.Row
Exit For
End If
Next finden
Cells(intZ, 1) = TextBox1 ' Name
Cells(intZ, 2) = TextBox2 ' Vorname
Cells(intZ, 3) = TextBox3 ' Kundennummer
Cells(intZ, 4) = Textbox4 ' Team
Cells(intZ, 5) = TextBox5 ' von
Cells(intZ, 6) = TextBox6 ' bis
Cells(intZ, 7) = TextBox7 ' Dauer in Monaten
Cells(intZ, 8) = TextBox8 ' ziel
TextBox13.SetFocus
End Sub
Private Sub CommandButton3_Click() ' Löschen
Dim intZ As Integer
Dim durchsuchen, finden As Range
Set durchsuchen = Sheets("Daten").Range("A2:B" & _
Sheets("Daten").Range("A65536").End(xlUp).Row)
For Each finden In durchsuchen
If finden.Text = TextBox1.Text Then
intZ = finden.Row
Exit For
End If
Next finden
Rows(intZ).Delete
Call Kontrollkaestchen_einfuegen
End Sub
Private Sub CommandButton4_Click() ' Eintragen
Dim intZ As Integer
intZ = Range("A65536").End(xlUp).Row + 1
Cells(intZ, 1) = TextBox1 ' Name.
Cells(intZ, 2) = TextBox2 ' Vorname
Cells(intZ, 3) = TextBox3 ' Kundennummer
Cells(intZ, 4) = Textbox4 ' Team
Cells(intZ, 5) = TextBox5 ' von
Cells(intZ, 6) = TextBox6 ' bis
Cells(intZ, 7) = TextBox7 ' Dauer in Monaten
Cells(intZ, 8) = TextBox8 ' ziel
TextBox13.SetFocus
End Sub
Private Sub CommandButton5_Click() ' Beenden
Unload Me
End Sub
Anzeige