Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1040to1044
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

UF zeigt Daten verkehrt an

UF zeigt Daten verkehrt an
16.01.2009 12:24:00
Wolfgang
Hallo,
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


3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Mustermappe anbei
16.01.2009 14:46:00
Wolfgang
Hallo,
ich hatte von Thorsten den Hinweis erhalten, doch besser eine Mustermappe beizufügen. Diese nun anbei. Vielleicht noch eine ergänzende Frage: Wenn Daten gelöscht werden, könnte es evtl. so gelöst werden, dass keine Leerzeilen entstehen? - Danke schon jetzt für die Rückmeldungen.
Herzliche Grüße
Wolfgang
https://www.herber.de/bbs/user/58481.xls
AW: Mustermappe anbei
16.01.2009 15:24:16
robert
hi,
bei dieser zeile das +1 raus
Controls("TextBox" & IntC) = Sheets("Daten").Cells(lngR, IntC ).Text
gruß
robert
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
Anzeige
Danke Robert - funktioniert
16.01.2009 15:46:00
Wolfgang
Hallo Robert,
herzlichen Dank für Deine schnelle Rückmeldung und Deinen Hinweis. Habe +1 entfernt und es läuft nun wunderbar. Nochmals Danke und einen schönen Tag noch!
Gruß - Wolfgang

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige