Office: (Office 2016) Drop down Auswahl mit Suche?!

iTouch · 31. März 2017

Hier schonmal die Ansicht:

@Ohrkester
ist es möglich Deine KundenMitBildUndSuchefeld3 Funltion auf diese Tabelle umzufunktionieren? Wie gesagt es werden immer nach Ort gesucht und dann nach Ortsteil.

Ohrkester · 31. März 2017

Servus,
Code:

Dim varInhalt As Variant
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Da die Variable vom Datentyp Variant ist, kann sowohl Text, als auch Zahl
ausgewertet werden.
Die Sub muss nur in der Zeile des SQL Statements geändert werden.
Code:

Einlesen = "SELECT * FROM tbl_Kunde"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Dort muss statt tbl_Kunde die gewünschte Tabelle oder Abfrage angegeben werden.
Entsprechende Abfragen müssen evtl. nachgebessert werden.
Die Sub wertet automatisch über alle Felder des Recordsets rs aus.
Sie ist aber auch optional einschränkbar über
Code:

For intFeld = 1 To rs.Fields.count
...
Next intField
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Dabei müssen die Felder innerhalb der Reihenfolge des Zählers sich befinden.

In Deinem Fall muss aus den beiden Tabellen tbl_Ort und tbl_Ortsteil, welche
1:n in Beziehung stehen müssen, eine Vereinigungsabfrage erstellt werden, welche dann als Datenquelle in die Sub Prozedur übergeben werden muss.
Dann geht alles automatisch.

Deine weiteren Wünsche sind da erst einmal nicht berücksichtigt, denn man müsste da mal generell mehr über dein Tabellenmodell wissen.

Ich hab mal mein Beispiel erweitert mit dem Feld KdNr, welches als Dateityp Zahl definiert ist. Spiel Dich mit diesem Feld in der Suche.

Diese Suche SubProzedur ist nur für einfache Suchen gedacht, wie es bei Dir
so zu sein scheint. Das Bitsqueezer Suchformular ist für Deinen genannten Anwendungsfall definitiv zu gross; wenn auch extrem interessant.
Ich werd Dir eine darauf basierende Beispiel DB per email schicken; nicht, weil ich geheimnissen will, sondern, weil die Dateigrösse zu gross ist.
Den Link zu Bitsqueezers Download Seite hab ich ja weitergegeben.
Auf Deine PN werde ich antworten (heute nicht mehr)

Josef P. · 31. März 2017

[Etwas OT, aber vielleicht trotzdem passend *wink.gif*]

Hallo!

Ich führte ein Refactoring vom Suchcode im Beispiel von Ohrkester aus.

Größte Veränderung:
Aus
Code:

If Nz(Me!Suchenfeld) "" Then
intFeld = rs.Fields.count
varInhalt = Split(strMuster, " ")
For intI = LBound(varInhalt) To UBound(varInhalt)
If Len(varInhalt(intI)) > 0 Then
If varInhalt(intI) = "+" Then
strlink = " And ("
Else
For intFeld = 1 To rs.Fields.count
If Len(strFilter) > 0 Then strFilter = strFilter & " Or "
strFilter = strFilter & "[" & rs.Fields(intFeld - 1).Name _
& "] Like '*" & varInhalt(intI) & "*'"
Next intFeld
If Len(strFilter1) > 0 Then
strFilter1 = strFilter1 & strlink & strFilter & ")"
strFilter = ""
Else
strFilter1 = "(" & strFilter & ")"
strFilter = ""
End If
strlink = " OR ("
End If
End If
Next intI
Einlesen = Einlesen & " Where " & strFilter1
Me!LstVollsuche.RowSource = Einlesen
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

machte ich
Code:

Private Function CreateFilterString(ByVal SuchText As String, ByVal BaseSql As String) As String

Dim DataFields As Collection
Dim Suchbegriffe() As String

Set DataFields = GetFieldsFromRecordBase(BaseSql)
Suchbegriffe = GetFirstLevelOrFilterValues(SuchText)

CreateFilterString = CreateFilterStringFromSuchbegriffArray(Suchbegriffe, DataFields)

End Function

Private Function CreateFilterStringFromSuchbegriffArray(ByRef Suchbegriffe() As String, ByVal DataFields As Collection)

Dim OrSuchBegriff As Variant
Dim AndSuchBegriff As Variant

With New FilterStringBuilder
.ConfigSqlFormat "\#yyyy-mm-dd\#", "True", "*"

For Each OrSuchBegriff In Suchbegriffe
With .NewConditionGroup(SQL_And)
For Each AndSuchBegriff In Split(OrSuchBegriff, "+")
AddFieldConditions .Self, AndSuchBegriff, DataFields
Next
End With
Next

CreateFilterStringFromSuchbegriffArray = .ToString(SQL_Or)

End With

End Function

Private Sub AddFieldConditions(ByVal ConditionGroup As FilterStringBuilder, ByVal SuchBegriff As String, ByVal DataFields As Collection)

Dim FieldName As Variant ' wegen for each kein String möglich

With ConditionGroup.NewConditionGroup(SQL_Or)
For Each FieldName In DataFields
' hier könnte man noch auf den DatenfeldTyp des Tabellenfeldes achten (dafür müsste die Collection erweitert werden - z. B. Type-Variael mit FieldName und Datatype)
.Add FieldName, SQL_Text, SQL_Like + SQL_Add_WildCardPrefix + SQL_Add_WildCardSuffix, SuchBegriff
Next
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Es entstanden etwas mehr Zeilen, dafür erkennt man (hoffentlich *wink.gif*) den Ablauf im Code etwas einfacher, da man nicht mehr mitdenken muss, wann welche Klammer gesetzt wird ... das erledigt die FilterStringBuilder-Klasse.

mfg
Josef

Mattes2 · 31. März 2017

JetComp komprimiert und repariert korrupte mdbs.
Das konvertiert, wie der Name eigentlich schon sagt, gar nichts. Ich kann die Files mit Acc2016
öffnen und auch in accdbs konvertieren. Brauchst Du aber nicht.
Das Beispiel von Ohrkester ist ok.

Ohrkester · 1. April 2017

Servus,
habs mal mit den Funktionen probiert.
@JosefP: Wie lautet dann der Aufruf?
Code:

CreateFilterString(ZwischenSpeicher, Einlesen)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mag er nicht.

Fehler beim Kompilieren. Erwartet =
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ebenso nicht
Code:

CreateFilterString ZwischenSpeicher, Einlesen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Da meckert er, dass ihm ein Verweis fehlt

Benutzerdefinierter Typ nicht definiert.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Markiert ist
geändert und neu editiert:
Code:

Private Sub AddFieldConditions(ByVal ConditionGroup As FilterStringBuilder, ByVal SuchBegriff As String, ByVal DataFields As Collection
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

So siehts momentan dann aus:
Code:

Private Sub Suchenfeld_AfterUpdate()
'Suchen über alle Tabellenfelder
' mit + kann man mehrere Suchparameter als UND-Suchkondition eingeben
' mit dem Leerzeichen kann man Suchparameter als ODER-Suchkondition eintragen
On Error GoTo Fehler
Dim varInhalt As Variant
Dim intI As Integer
Dim strFilter As String
Dim strFilter1 As String
Dim intFeld As Integer
Dim strMuster As String
Dim strSQL, strsql1 As String
Dim strlink As String
Dim ZwischenSpeicher As String
Dim rs As DAO.Recordset
Einlesen = ""
Einlesen = "SELECT * FROM tbl_Kunde"
Set rs = CurrentDb.OpenRecordset(Einlesen)

If Nz(Me!Suchenfeld, "") = "" Then
MsgBox "Kein Eintrag im gelben Suchfeld"
Exit Sub
End If

ZwischenSpeicher = Me!Suchenfeld
Me!Suchenfeld.AllowAutoCorrect = False
strMuster = Replace(Me!Suchenfeld, "+", " + ")
strMuster = Replace(StrConv(strMuster, vbProperCase), " ", " ")

CreateFilterString ZwischenSpeicher, Einlesen

Me!Suchenfeld = ZwischenSpeicher
Me!Suchenfeld.SetFocus
rs.Close
Set rs = Nothing
exit_Fehler:
Exit Sub
Fehler:
MsgBox "Fehler. Die Abfrage ist entweder zu komplex oder ein anderer Fehler ist aufgetreten. " & vbCrLf & _
"Versuchen Sie es mal alternativ mit dem '+' Zeichen im Suchtext"
Resume exit_Fehler
End Sub

Private Function CreateFilterString(ByVal SuchText As String, ByVal BaseSql As String) As String

Dim DataFields As Collection
Dim Suchbegriffe() As String

Set DataFields = GetFieldsFromRecordBase(BaseSql)
Suchbegriffe = GetFirstLevelOrFilterValues(SuchText)

CreateFilterString = CreateFilterStringFromSuchbegriffArray(Suchbegriffe, DataFields)

End Function

Private Function CreateFilterStringFromSuchbegriffArray(ByRef Suchbegriffe() As String, ByVal DataFields As Collection)

Dim OrSuchBegriff As Variant
Dim AndSuchBegriff As Variant

With New FilterStringBuilder
.ConfigSqlFormat "#yyyy-mm-dd#", "True", "*"

For Each OrSuchBegriff In Suchbegriffe
With .NewConditionGroup(SQL_And)
For Each AndSuchBegriff In Split(OrSuchBegriff, "+")
AddFieldConditions .Self, AndSuchBegriff, DataFields
Next
End With
Next

CreateFilterStringFromSuchbegriffArray = .ToString(SQL_Or)

End With

End Function

Private Sub AddFieldConditions(ByVal ConditionGroup As FilterStringBuilder, ByVal SuchBegriff As String, ByVal DataFields As Collection)

Dim FieldName As Variant ' wegen for each kein String möglich

With ConditionGroup.NewConditionGroup(SQL_Or)
For Each FieldName In DataFields
' hier könnte man noch auf den DatenfeldTyp des Tabellenfeldes achten (dafür müsste die Collection erweitert werden - z. B. Type-Variael mit FieldName und Datatype)
.Add FieldName, SQL_Text, SQL_Like + SQL_Add_WildCardPrefix + SQL_Add_WildCardSuffix, SuchBegriff
Next
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Josef P. · 1. April 2017

Hallo!

Ich zeigte nur einen Teil der Änderungen. Im angehängten Beispiel in Beitrag #18 ist alles enthalten.

Aufruf erfolg über:
Code:

Private Sub Suchenfeld_AfterUpdate()

With Me.Suchenfeld
If Len(Trim(Nz(.Value, vbNullString))) = 0 Then
MsgBox "Kein Eintrag im gelben Suchfeld"
Exit Sub
End If

.AllowAutoCorrect = False
ListboxFiltern .Value

End With

End Sub

Private Sub ListboxFiltern(ByVal SuchText As String)

Dim FilterString As String
Dim ListboxSql As String

ListboxSql = "SELECT * FROM tbl_Kunde"
FilterString = CreateFilterString(SuchText, ListboxSql)

ListboxSql = ListboxSql & " Where " & FilterString
Me.LstVollsuche.RowSource = ListboxSql

End Sub

Private Function CreateFilterString(ByVal SuchText As String, ByVal BaseSql As String) As String

Dim DataFields As Collection
Dim Suchbegriffe() As String

Set DataFields = GetFieldsFromRecordBase(BaseSql)
Suchbegriffe = GetFirstL (evelOrFilterValues(SuchText)

CreateFilterString = CreateFilterStringFromSuchbegriffArray(Suchbegriffe, DataFields)

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

In der Prozedur CreateFilterString siehst du die Trennung der verschiedenen Aufgaben am besten.
GetFieldsFromRecordBase ermittelt die Datenfelder die gefiltert werden sollen.
GetFirstLevelOrFilterValues (Name wäre noch besser zu gestalten) bereitet die Suchbegriffe auf.
CreateFilterStringFromSuchbegriffArray erzeugt den Filterausdruck.

Das Ergebnis wird in ListboxFiltern benutzt um die SQL-Anweisung zusammenzustellen.

Vorteil dieser Aufteilung: Falls einmal Probleme auftreten, kann man die Funktionsweise der Prozeduren einzeln überprüfen.

mfg
Josef

Ohrkester · 1. April 2017

Servus,
@josef P:
Keine Ahnung, welcher Verweis bei mir fehlen sollte.
Ich habs so übernommen (bis auf den kleinen Lapsus )
Code:

Suchbegriffe = GetFirstL (evelOrFilterValues(SuchText)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

geändert auf
Code:

Suchbegriffe = GetFirstLevelOrFilterValues(SuchText)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Trotzdem wird bei mir immer ein fehlender Verweis angemeckert.
Ich wüsste nicht, welcher das sein soll.
Magste mal nachschauen, bitte?

Nouba · 1. April 2017

Hi,

Du benötigst auch die drei Klassenmodule aus Josefs Upload.

Ohrkester · 2. April 2017

Servus,
@Nouba: Danke, den Anhang hatte ich komplett übersehen.
@josef P.: ich hatte einen Balken vor den Augen...sorry.
Mein Suchcode ist für kleine Suchen gedacht.
Deshalb funktioniert das mit dem Datum und Zahlen für mich ausreichend.
Bei komplexeren Suchen hat Bitsqueezer ein wunderbares Suchformular
erstellt, welches ich dann benutze.
Hier eine Beispiel DB, welche einen Ausschnitt der Möglichkeiten dieses Suchformulars bietet.
Ich füge sie als rar an, weil zip die erlaubte Dateigrösse überschreitet.
Das Original gibt es auf http://www.ccedv.de/downloads/start.php?lang=de
unter dem Namen CCFilterV2_7
Das ist allerdings eine um eine Versionsnummer ältere Version.

OrionVII · 2. April 2017

Könnte da ein Ajax-Suche auch etwas bringen?

Code:

'Mit jedem Tastenanschlag von Buchstaben oder Zahlen, Backspace oder Entf. wird im Kombifeld nach dem
'eingegebenen String gesucht und bei geöffneten Kombifeld angezeigt.

Private Sub DeinKombifeld_KeyUp(KeyCode As Integer, Shift As Integer)
Dim strSQL As String

strSQL = ""
If (KeyCode >= vbKeyA And KeyCode = vbKey0 And KeyCode
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

iTouch · 12. April 2017

Vielen Dank euch allen!

Ich werde erstmal versuchen alle Vorschläge umzusetzen.

Viele Grüße
iTouch

Office: (Office 2016) Drop down Auswahl mit Suche?!

Drop down Auswahl mit Suche?!

Drop down Auswahl mit Suche?!

Drop down Auswahl mit Suche?!

Drop down Auswahl mit Suche?!

Drop down Auswahl mit Suche?! - Similar Threads - Drop down Auswahl

Serienbrieffelder Auswahl im Dokument

Dropdown-Auswahl in andere Zelle einfügen

Dropdown - bei Auswahl bestimmte Texte in Zeilen einfügen

Name auswählen und Werte in Zeile ändern

Diagramme in Abhängigkeit von DropDown-Auswahl einblenden

Drop&Down Menü auswahl automatisieren

Erster Buchstabe einer drop down Auswahl als Grossbuchstabe