Excel 2013 - Suchfunktion

[tomtom2718]

Guten Abend allerseits
Benötige wieder mal hilfe von profis.

Suchfunktion und einfügen der Daten aus listbox funktioniert nicht.
was mache ich falsch.

Beim klick auf Zeile Listbox;(Private Sub ListBox1_Click())

Fehler beim Kompiliern:
Varialble nicht definiert!

code userform

PHP-Code:

Option Explicit
Private Sub Image5_Click()

' suchen nach Suchbegriff in entsprechender Spalte und gibt Ergebnis in Listbox aus
Dim vntErg As Variant
Dim i As Byte
Dim blngefunden As Boolean



ListBox1.Clear
ListBox1.Visible = True
Label63.Visible = True


For i = 1 To 15
 If Len(Me.Controls("TextBox" & i)) Then
   If sucheDatensatz(Me.Controls("TextBox" & i).Value, i, vntErg) Then ListBox1.List = vntErg
   blngefunden = True
   Exit Sub
  End If
Next

If Not blngefunden Then UserForm2.Show
End Sub



Private Sub ListBox1_Click()
'überträgt ausgewählten Datensatz in Textboxen
For i = 1 To 15

    Me.Controls("TextBox" & i) = ListBox1.List(ListBox1.ListIndex, i)
Next
ListBox1.Visible = False

End Sub
Private Sub cmdändern_Click()
 Datensätz ändern
    
   schreibeDaten Worksheets("Matrix"), ListBox1.Value
    
Unload Me

End Sub 


code modul

PHP-Code:

Global zeile As Integer
Public schalter As Integer


Sub schreibeDaten(ByVal sh As Worksheet, ByVal lrow As Long)

With sh

For i = 1 To 16
 .Cells(lrow, i) = UserForm1.Controls("Textbox" & i)
Next
End With

End Sub

Function sucheDatensatz(ByVal strSuch As String, ByVal Spalte As Integer, vntOut As Variant) As Boolean
Dim c As Range
Dim firstaddress
Dim strErg As String
With Worksheets("Matrix").Columns(Spalte)

    Set c = .Find(what:=strSuch, LookIn:=xlValues, lookat:=xlWhole)
    
    If Not c Is Nothing Then
        firstaddress = c.Address
            Do
                strErg = strErg & c.Row & ","
                
                Set c = .FindNext(c)
                
            Loop While c.Address <> firstaddress
    Else
        MsgBox " Suchbegriff nicht gefunden"
    End If
End With

ReDim vntOut(0 To UBound(Split(",")), 0 To 16)
If Len(strErg) Then
    sucheDatensatz = True
    ReDim vntOut(0 To UBound(Split(strErg, ",")), 0 To 16)
        For i = 0 To UBound(Split(strErg, ",")) - 1
            For j = 1 To 16
                vntOut(i, j) = Cells(Split(strErg, ",")(i), j)
            Next
            vntOut(i, 0) = Split(strErg, ",")(i)
        Next
End If
End Function 


Bin für jede unterstützung Dankbar

Beste Grüsse
Toni

[Hajo_Zi]

Hallo Toni,

Ich baue keine Datei nach. Die Zeit hat schon jemand investiert.

Ein Nachbau sieht meist anders aus als das Original. Darum sollte das Original verlinkt werden.

Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.
Es sollte ein aussagekräftiger Name sein.

[drambeldier]

Moin,

Zitat:

was mache ich falsch.

mit der Fehlermeldung sollte irgend eine Zeile markiert sein, in der die Variable benutzt wird.

[tomtom2718]

Hallo zusammen

Fehler beim Kompiliern:
Varialble nicht definiert
Der Fehler wird in Zeile



For i = 1 To 15

im
Private Sub ListBox1_Click()
'überträgt ausgewählten Datensatz in Textboxen

angezeigt.

Kann im moment keine Beispieldatei hochladen.
muss mir noch das Winzip kaufen, Testversion ist abgelaufen.

Vielen Dank im Voraus.

Beste Grüsse
Toni

[aloys78]

Hallo Toni,

Zitat:

For i = 1 To 15

Du hast in dieser Prozedur die Variable i nicht definiert, und da Du "Option explicit" angegeben hast, fällt dies dem Compiler auf.

Außerdem würde ich i als Long definieren.

Gruß
Aloys

[RPP63neu]

Moin!
Da liegt noch einiges im Argen.

ReDim vntOut(0 To UBound(Split(",")), 0 To 16)

wird auch in einen Fehler laufen!

Zitat:

muss mir noch das Winzip kaufen, Testversion ist abgelaufen.

"Mein" Windows hat eine eingebaute Zip-Funktion.

Gruß Ralf

[tomtom2718]

Guten Tag allerseits

Erstmal vielen Dank.

komme leider nicht weiter.
habe mal die abgespeckte datei beigelegt.
Ich hoffe ihr könnt mir weiterhelfen.

Besten Dank im Voraus
Grüsse
Toni

[tomtom2718]

Hat geklappt

ich habe i as long definiert und Option Explicit entfernt.
und im Modul die anzahl Textboxen angepasst.

Vielen herzlichen Dank für eure Unterstützung

Grüsse Toni

[drambeldier]

Zitat:

ich habe i as long definiert

gut.

Zitat:

und Option Explicit entfernt.

schlecht, weil man sich nach den Fehlern, die dadurch entstehen können, dumm und dämlich sucht. Nichts ist schlimmer als die Überzeugung, alles richtig gemacht zu haben.

[tomtom2718]

Hallo Ralf

Vielen Dank für die Rückmeldung.
Wie müsste ich dann Vorgehen um diesen Fehler korrkt zu korrigieren.
Besen Dank im Voraus.
Gruss Toni

[Muller]

Hallo,

na, wie Ralf schon schrieb, Du lässt einfach Option Explicit stehen, am Anfang immer mal dies hier durchlesen und verinnerlichen, dann bist schonmal auf dem richtigen Weg...

http://www.online-excel.de/excel/singsel_vba.php?f=4

Gruß, Muller

[tomtom2718]

hallo Zusammen
@müller

Vielen Dank für den Link.
Blicke immer noch nicht ganz durch.

Habe, glaube ich zumindest, die Lösung gefunden.

PHP-Code:

Option Explicit
Private Sub Image5_Click()
' suchen nach Suchbegriff in entsprechender Spalte und gibt Ergebnis in Listbox aus
Dim vntErg As Variant
Dim i As Long
Dim blngefunden As Boolean



ListBox1.Clear
ListBox1.Visible = True
Label63.Visible = True
cmdändern.Visible = True


For i = 1 To 15
 If Len(Me.Controls("TextBox" & i)) Then
   If sucheDatensatz(Me.Controls("TextBox" & i).Value, i, vntErg) Then ListBox1.List = vntErg
   blngefunden = True
   Exit Sub
  End If
Next


If Not blngefunden Then UserForm2.Show
End Sub
Private Sub ListBox1_Click()
'überträgt ausgewählten Datensatz in Textboxen
Dim i As Long
For i = 1 To 15

    Me.Controls("TextBox" & i) = ListBox1.List(ListBox1.ListIndex, i)
Next
ListBox1.Visible = False
Image5.Visible = False
End SubPrivate Sub cmdändern_Click()
 Datensätz ändern
    
   schreibeDaten Worksheets("Matrix"), ListBox1.Value
    
Unload Me

End Sub 


modul

PHP-Code:

Global zeile As Integer
Public schalter As Integer


Sub schreibeDaten(ByVal sh As Worksheet, ByVal lrow As Long)

With sh

For i = 1 To 15
 .Cells(lrow, i) = UserForm1.Controls("Textbox" & i)
Next
End With

End Sub

Function sucheDatensatz(ByVal strSuch As String, ByVal Spalte As Integer, vntOut As Variant) As Boolean
Dim c As Range
Dim firstaddress
Dim strErg As String

Worksheets("Matrix").Activate 'aktiviere gewünschte Tabelle'


With Worksheets("Matrix").Columns(Spalte)

    Set c = .Find(what:=strSuch, LookIn:=xlValues, lookat:=xlWhole)
    
    If Not c Is Nothing Then
        firstaddress = c.Address
            Do
                strErg = strErg & c.Row & ","
                
                Set c = .FindNext(c)
                
            Loop While c.Address <> firstaddress
    Else
        MsgBox " Suchbegriff nicht gefunden"
    End If
End With

ReDim vntOut(0 To UBound(Split(",")), 0 To 15)
If Len(strErg) Then
    sucheDatensatz = True
    ReDim vntOut(0 To UBound(Split(strErg, ",")), 0 To 15)
        For i = 0 To UBound(Split(strErg, ",")) - 1
            For j = 1 To 15
                vntOut(i, j) = Cells(Split(strErg, ",")(i), j)
            Next
            vntOut(i, 0) = Split(strErg, ",")(i)
        Next
End If
End Function 


So erhalte ich keine Fehlermeldungen
Wenn sich jemand Zeit nehmen könnte den Code zu kontrollieren währe ich sehr Dankbar.
Beste Grüsse
Toni