Suchen in Tabelle, zwei Ausgabemöglichkeiten
22.01.2013 12:17:08
René
Ich suche sehr viel im Netz nach Codeschnipsel und bastle so lange an diesen herum bis sie an meine Bedürfnisse angepasst sind. Leider verstehe ich so manche Codeteile überhaupt nicht, komme im Moment nich weiter und benötige Hilfe.
Ich habe eine Userform mit einer Multipage mit zwei Seiten erstellt.
Auf Seite 1 befinden sich eine Textbox, 2 Button und eine Listbox. Die Listbox wird mehrspaltig Anhand eines Suchbegriffs aus der Textbox gefüllt.
Code für Suche:
Private Sub Los2_Click()
Dim rngCell As Range
Dim strFirstAddress As String
If TextBox1 = "" Then
MsgBox "Bitte Suchparameter eingeben. ", 48
TextBox1.SetFocus
Exit Sub
End If
With Worksheets("Schlüsselliste").Range("E:E")
Me.ListBox1.Clear
Set rngCell = .Find(Me.TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
With Me.ListBox1
.ColumnCount = 10
.AddItem
.List(.ListCount - 1, 0) = rngCell.Value
.List(.ListCount - 1, 1) = rngCell.Offset(0, 1).Value
.List(.ListCount - 1, 2) = rngCell.Offset(0, 2).Value
.List(.ListCount - 1, 3) = rngCell.Offset(0, 3).Value
.List(.ListCount - 1, 4) = rngCell.Offset(0, 4).Value
.List(.ListCount - 1, 5) = rngCell.Offset(0, 5).Value
.List(.ListCount - 1, 6) = rngCell.Offset(0, 6).Value
.List(.ListCount - 1, 7) = rngCell.Offset(0, 7).Value
.List(.ListCount - 1, 8) = rngCell.Offset(0, 8).Value
.List(.ListCount - 1, 9) = rngCell.Offset(0, 9).Value
.ColumnWidths _
= "6,0cm;3,0cm;2,0cm;2,0cm;2,0cm;3,0cm;0,0cm;0,0cm;0,0cm;2,5cm"
End With
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address strFirstAddress
Else
MsgBox "Für diese Straße ist kein Eintrag vorhanden ", 48
TextBox1.SetFocus
End If
End With
End Sub
Mein erstes Problem ist nun beim Ausdruck der markierten Zeilen in der Listbox.
Code für Ausdruck:
Private Sub CommandButton5_Click()
Dim wks As Worksheet
Dim lngI As Long
Dim lngZ As Long
Dim intS As Integer
Set wks = Worksheets("Auswahl")
lngZ = 2
wks.Range("A2:O" & wks.Range("A65536").End(xlUp).Row + 2).ClearContents
With Me.ListBox1
For lngI = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(lngI) Then
For intS = 0 To 9
wks.Cells(lngZ, intS + 1) = .List(lngI, intS)
Next
lngZ = lngZ + 1
End If
Next
End With
Sheets("Auswahl").Visible = True
Sheets("Auswahl").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveWindow.SelectedSheets.Visible = False
End Sub
Mein zweites Problem befindet sich auf der Seite 2 der Multipage. Hier befinden sich 15 Textboxen und 3 Button. Diese Textboxen werden auch mittels Suchabfrage gefüllt.
Code für zweite Suche:
Private Sub CommandButton6_Click()
Dim rngCell As Range
Dim strFirstAddress As String
If TextBox2 = "" Then
MsgBox "Bitte Suchparameter eingeben. ", 48
TextBox2.SetFocus
Exit Sub
End If
With Worksheets("Schlüsselliste").Range("A:A")
Me.ListBox1.Clear
Set rngCell = .Find(Me.TextBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
With TextBox2 = rngCell.Value
TextBox3 = rngCell.Offset(0, 1).Value
TextBox4 = rngCell.Offset(0, 2).Value
TextBox5 = rngCell.Offset(0, 3).Value
TextBox6 = rngCell.Offset(0, 4).Value
TextBox7 = rngCell.Offset(0, 5).Value
TextBox8 = rngCell.Offset(0, 6).Value
TextBox9 = rngCell.Offset(0, 7).Value
TextBox10 = rngCell.Offset(0, 8).Value
TextBox11 = rngCell.Offset(0, 9).Value
TextBox12 = rngCell.Offset(0, 10).Value
TextBox13 = rngCell.Offset(0, 11).Value
TextBox14 = rngCell.Offset(0, 12).Value
TextBox15 = rngCell.Offset(0, 13).Value
TextBox16 = rngCell.Offset(0, 14).Value
End With
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address strFirstAddress
Else
MsgBox "Für diesen Barcode ist kein Eintrag vorhanden ", 48
TextBox2.SetFocus
End If
End With
End Sub
Code zum aktivieren der Textboxen:
Private Sub CommandButton8_Click()
Anfang:
If PasswortHolen1("Bitte Passwort eingeben") = "xxx" Then
TextBox3.Enabled = True
TextBox4.Enabled = True
TextBox5.Enabled = True
TextBox6.Enabled = True
TextBox7.Enabled = True
TextBox8.Enabled = True
TextBox9.Enabled = True
TextBox10.Enabled = True
TextBox11.Enabled = True
TextBox12.Enabled = True
TextBox13.Enabled = True
TextBox14.Enabled = True
TextBox15.Enabled = True
TextBox16.Enabled = True
Else
If MsgBox("Das Passwort ist ungültig! Möchten Sie es nochmals versuchen?", _
vbYesNo, "Fehler") = vbYes Then GoTo Anfang
End If
End Sub
Bis dahin geht alles super. Jetzt kommt das zweite Problem. Ich möchte jetzt in den Textboxen 4-16 eventuell die vorhanden Einträge ändern und nach betätigen des 3ten Buttons diese genau in der Zeile der Tabelle speichern, wo ich die Daten ausgelsen habe. Hier habe ich aber im Moment noch kein Plan, wie ich das umsetzen kann.
Ich hoffe ich habemich soweit verständlich ausgedrückt, welche Probleme sich mir im Moment in den Weg stellen und hoffe das man mir helfen kann.
Bedanke mich im Voraus.
MfG
René