Moteur de recherche via mot clés

Bonjour à tous,

j'ai déjà codé des systèmes de moteur de recherche qui allait chercher des mots dans différentes colonnes avec ce genre de codage

Public Sub Listing_Partners()
   Dim b()
   tmp1 = Me.TextBox1 & "*": tmp2 = Me.TextBox2 & "*": tmp3 = Me.TextBox3 & "*"
   n = 0
   For i = LBound(TblBD) To UBound(TblBD) 
     If TblBD(i, 1) Like "*" & tmp1 & "*" And TblBD(i, 2) Like "*" & tmp2 & "*" And TblBD(i, 3) Like "*" & tmp3 & "*" Then
      n = n + 1: ReDim Preserve b(1 To NbCol + 1, 1 To n)
      For k = 1 To NbCol: b(k, n) = TblBD(i, k): Next k
    End If
   Next i
   If n > 0 Then Me.List_Partners.Column = b Else Me.List_Partners.Clear

End Sub

Ceci étant dit j'ai désormais besoin d'en mettre un en place un peu différent et aurais besoin de votre aide

dans un userform en cours de mise au point je propose 4 champs mot clés différents de recherche et si je procède comme avant je lancerai la mise à jour de ma listebox via

Private Sub Keyword1_Change()
Listing_PI
End Sub
Private Sub Keyword2_Change()
Listing_PI
End Sub
Private Sub Keyword3_Change()
Listing_PI
End Sub
Private Sub Keyword4_Change()
Listing_PI
End Sub

sauf qu'ici je voudrais que ca puisse aller chercher dans plusieurs colonnes différentes un ou plusieurs mot clés

je dois chercher dans les colonnes D, E et F si un ou plusieurs mots clés sont reconnus

Aussi comment changer le passage ci dessous?

  If TblBD(i, 1) Like "*" & tmp1 & "*" And TblBD(i, 2) Like "*" & tmp2 & "*" And TblBD(i, 3) Like "*" & tmp3 & "*" Then
      n = n + 1: ReDim Preserve b(1 To NbCol + 1, 1 To n)
      For k = 1 To NbCol: b(k, n) = TblBD(i, k): Next k
    End If

le code dans son ensemble:

Option Compare Text
Dim TblBD(), NbCol

Public Sub UserForm_Initialize()
colvisu = Array(1, 3, 5)
LargeurCol = Array(90, 90, 150)

NomTableau = "PI_Table"
TblBD = Range(NomTableau)
Results_PI.ColumnCount = Range(NomTableau).Columns.Count - 6
Results_PI.ColumnWidths = Join(LargeurCol, ";")

    Dim Tbl()
  For i = 1 To UBound(TblBD)

        n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        'For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
         c = 0
         For Each k In colvisu
           c = c + 1: Tbl(c, n) = TblBD(i, k)
         Next k

   Next i
   If n > 0 Then Results_PI.Column = Tbl Else Results_PI.Clear

End Sub

Private Sub Keyword1_Change()
Listing_PI
End Sub
Private Sub Keyword2_Change()
Listing_PI
End Sub
Private Sub Keyword3_Change()
Listing_PI
End Sub
Private Sub Keyword4_Change()
Listing_PI
End Sub

Public Sub Listing_PI()
   Dim b()
   tmp1 = Me.Keyword1 & "*": tmp2 = Me.Keyword2 & "*": tmp3 = Me.Keyword3 & "*": tmp4 = Me.Keyword4 & "*"
   n = 0
   For i = LBound(TblBD) To UBound(TblBD)

     If TblBD(i, 1) Like "*" & tmp1 & "*" And TblBD(i, 2) Like "*" & tmp2 & "*" And TblBD(i, 3) Like "*" & tmp3 & "*" Then
      n = n + 1: ReDim Preserve b(1 To NbCol + 1, 1 To n)
      For k = 1 To NbCol: b(k, n) = TblBD(i, k): Next k
    End If
   Next i
   If n > 0 Then Me.Results_PI.Column = b Else Me.Results_PI.Clear

End Sub

merci à vous par avance

@+

Salut DarkAngel,

Normalement il suffit d'enlever les premières "*"

Public Sub Listing_PI()
  Dim Tmp1 As String, Tmp2 As String, Tmp3 As String, Tmp4 As String
  Dim b()
  Tmp1 = Me.Keyword1: Tmp2 = Me.Keyword2: Tmp3 = Me.Keyword3: Tmp4 = Me.Keyword4
  n = 0
  For i = LBound(TblBD) To UBound(TblBD)
    If TblBD(i, 1) Like "*" & Tmp1 & "*" _
      And TblBD(i, 2) Like "*" & Tmp2 & "*" _
      And TblBD(i, 3) Like "*" & Tmp3 & "*" _
      And TblBD(i, 4) Like "*" & Tmp4 & "*" Then
      n = n + 1: ReDim Preserve b(1 To NbCol + 1, 1 To n)
      For k = 1 To NbCol: b(k, n) = TblBD(i, k): Next k
    End If
  Next i
  If n > 0 Then Me.Results_PI.Column = b Else Me.Results_PI.Clear
End Sub

Mais sans fichier que je sais que tu ne peux partager, c'est compliqué de savoir

@+

salut bruno,

Ravi de te revoir ici.

merci pour ton retour mais ceci étant dit et sauf erreur les * d'avant c'est pour une recherche avant le texte indiqué

ici il s'agit de chercher avant et après les mots clés mais dans plusieurs colonnes

dans mon cas il faut chercher dans TblDB(i,3) & TblBD(1,4) et TblBD(1,5) chaque mot clé séparément et ensemble et me faire une remontée de résultat

je peux essayer de faire un fichier test si besoin était mais en MP

Je t'envoi un fichier exemple en mp

A tout hasard, j'ai tenté ceci mais sans résultat concret

     For i = LBound(TblBD) To UBound(TblBD)
If TblBD(i, 4) Like "*" & tmp1 & "*" _
Or TblBD(i, 4) Like "*" & tmp2 & "*" _
Or TblBD(i, 4) Like "*" & tmp3 & "*" _
Or TblBD(i, 4) Like "*" & tmp4 & "*" _
Or TblBD(i, 5) Like "*" & tmp1 & "*" _
Or TblBD(i, 5) Like "*" & tmp2 & "*" _
Or TblBD(i, 5) Like "*" & tmp3 & "*" _
Or TblBD(i, 5) Like "*" & tmp4 & "*" _
Or TblBD(i, 6) Like "*" & tmp1 & "*" _
Or TblBD(i, 6) Like "*" & tmp2 & "*" _
Or TblBD(i, 6) Like "*" & tmp3 & "*" _
Or TblBD(i, 6) Like "*" & tmp4 & "*" _
Then

Salut Darkangel,

Voici le code modifié en entier, pas forcément optimisé, mais qui fonctionne me semble-t-il

Option Explicit
Option Compare Text

Dim TblBd() As Variant
Dim NbCol As Long, C As Long, N As Long
Dim ColVisu As Variant

Private Sub Keyword1_Change()
  Listing_PI
End Sub

Private Sub Keyword2_Change()
  Listing_PI
End Sub
Private Sub Keyword3_Change()
  Listing_PI
End Sub
Private Sub Keyword4_Change()
  Listing_PI
End Sub

Public Sub UserForm_Initialize()
  Dim NomTableau
  Dim LargeurCol As Variant
  Dim i As Integer, k
  ColVisu = Array(1, 3, 5)
  LargeurCol = Array(90, 90, 150)

  NomTableau = "PI_Table"
  TblBd = Range(NomTableau).Value
  NbCol = UBound(TblBd, 2)
  Me.Results_PI.ColumnCount = Range(NomTableau).Columns.Count - 6
  Me.Results_PI.ColumnWidths = Join(LargeurCol, ";")

  Dim Tbl()
  For i = 1 To UBound(TblBd)
    N = N + 1: ReDim Preserve Tbl(1 To UBound(TblBd, 2), 1 To N)
    C = 0
    For Each k In ColVisu
      C = C + 1: Tbl(C, N) = TblBd(i, k)
    Next k
    NbCol = C
  Next i
  If N > 0 Then Results_PI.Column = Tbl Else Results_PI.Clear
End Sub

Public Sub Listing_PI()
  Dim i As Integer, k
  Dim Col As Integer, FlgTrouvé As Boolean
  Dim b() As Variant
  Dim Tmp1 As String, Tmp2 As String, Tmp3 As String, Tmp4 As String
  '
  ColVisu = Array(1, 3, 5)
  Tmp1 = Me.Keyword1: Tmp2 = Me.Keyword2: Tmp3 = Me.Keyword3: Tmp4 = Me.Keyword4
  N = 0: Erase b
  For i = LBound(TblBd) To UBound(TblBd)
    FlgTrouvé = False
    For Col = 4 To 6
      If Tmp1 <> "" Then
        If TblBd(i, Col) Like "*" & Tmp1 & "*" Then FlgTrouvé = FlgTrouvé + True
      End If
      If Tmp2 <> "" Then
        If TblBd(i, Col) Like "*" & Tmp2 & "*" Then FlgTrouvé = FlgTrouvé + True
      End If
      If Tmp3 <> "" Then
        If TblBd(i, Col) Like "*" & Tmp3 & "*" Then FlgTrouvé = FlgTrouvé + True
      End If
      If Tmp4 <> "" Then
        If TblBd(i, Col) Like "*" & Tmp4 & "*" Then FlgTrouvé = FlgTrouvé + True
      End If
    Next Col
    ' Si terme trouvé
    If FlgTrouvé Then
      N = N + 1: ReDim Preserve b(1 To NbCol + 1, 1 To N)
      C = 0: For Each k In ColVisu: C = C + 1: b(C, N) = TblBd(i, k): Next k
    End If
  Next i
  If N > 0 Then Me.Results_PI.Column = b Else Me.Results_PI.Clear
End Sub

Et un fichier exemple

@+

Salut Bruno,

Merci à toi, Je ne demandais pas forcement un retour aussi rapide et en pleine nuit :)

En tout cela semble parfaitement correspondre à mon besoin, merci à toi.

bon weekend

Re,

T'inquiète quand j'ai une insomnie faut que je m'occupe

@+