XL 2019 LE RESULTATS D UN MATCH RECHERCHE RAPIDE

[frederio]

Bonjour a tous

Mon petit problème :

J’ai un fichier Excel pour sur rechercher rapide

Sur la 1ère feuille "RECHERCHER RAPIDE " et la 2ère feuilles "SAISON "

Tu vous connais comment faire ?

Si tu veux être d’accord avec moi ??? vous m’aidez a expliqué comme Excel Merci

 

[ChTi160]

Ok
Je regarde demain !
Jean marie

 

[frederio]

ok j espère bien demain

 

[frederio]

Option Explicit

Public Function Alim_Combo(ByVal T As Variant, ByRef TabStrSearch As Variant) As Variant

Dim i As Long, j As Long, k As Byte
Dim Tablo(), Tmp, Sptd
x = 0

  If NBrOpt = 3 Then
        With UsF_Recherche
                .CBn_Init = True
                .Lbl_Info.Caption = ""
                .Lbl_Info.ForeColor = &HFF&

          NBrOpt = 0
          Exit Function
         End With
  End If
    ' Saison                    'N                         'Equipe               'Domicile ou Exterieur
str = TabStrSearch(1, 1) & "!" & TabStrSearch(2, 1) & "!" & TabStrSearch(3, 1) & "!" & TabStrSearch(6, 1)
 
   NBrOpt = 0 'remise à zero
  
For k = 1 To 6 'pour les 6 Colonnes
If k < 4 Or k = 6 Then 'si K = aux Colonnes 1,2,3,6
           x = x + 1 'On incremente
  Set Sptd = CreateObject("Scripting.Dictionary") 'avec le Dictionnaire ainsi définit
       Sptd.Add IIf(k < 4 Or k = 6, "< TOUTES >", "< TOUS >"), IIf(k < 4 Or k = 6, "< TOUTES >", "< TOUS >")   'On entre la premiere Lignes qui correspond a "Toutes" et "Tous" en fonction des Colonnes
'    With Ws_S
    
        For Ligne = 2 To UBound(T, 1) 'pour chaque lignes du tableau
          
    StrCompare = T(Ligne, 1) & "!" & T(Ligne, 2) & "!" & T(Ligne, 3) & "!" & T(Ligne, 6) '& "!" & T(Ligne, 9) & "!" & T(Ligne, 10)
           If StrCompare Like str Then
           If Not Sptd.Exists(T(Ligne, k)) Then Sptd.Add T(Ligne, k), T(Ligne, k)
           End If
        Next Ligne
        Tablo = Sptd.items
        For i = 1 To UBound(Tablo)
           For j = 1 To UBound(Tablo)
               If Tablo(i) < Tablo(j) Then
                  Tmp = Tablo(i)
                  Tablo(i) = Tablo(j)
                  Tablo(j) = Tmp 'IIf(x = 5 Or x = 6, Format(Tmp, "dd/mm/yyyy"), Tmp)
               End If
           Next j
        Next i
'    End With
    With UsF_Recherche.Controls("CBx_" & x)
                      .Clear: EventOff = True
                      .List = Tablo
                      .Text = IIf(TabStrSearch(k, 1) = "*", TabStrSearch(k, 2), TabStrSearch(k, 1))
                      .ListRows = IIf(.ListCount > 25, 25, .ListCount)
                   If .ListCount = 2 Then
                      .ListIndex = 1
                      .BackColor = &HC0FFFF
                      .ForeColor = &HFF&
                          NBrOpt = NBrOpt + 1
                                        GoTo suite
                    End If
                      .BackColor = IIf(TabStrSearch(k, 1) = "*", &HFF00&, &HC0FFFF)
                      .ForeColor = IIf(TabStrSearch(k, 1) = "*", &HFF0000, &HFF&)
suite:
             TabStrSearch(k, 1) = IIf(InStr(1, .Text, "< TOU"), "*", .Text)
                 EventOff = False
                 If k < 4 Or k = 6 Then UsF_Recherche.Controls("LBl_Nbr_" & x) = .ListCount - 1
    End With
  Set Sptd = Nothing
  Erase Tablo
   End If
Next k

With UsF_Recherche
    'ci dessous on colle le nombre d'item trouvés
    .Lbl_Info.Caption = "Résultat du Filtre   :   " & .CBx_1.ListCount - 1 & "   Ligne" & IIf(.CBx_1.ListCount - 1 = 1, "", "s") & " Trouvée" & IIf(.CBx_1.ListCount - 1 = 1, "", "s")
     With .CBn_Init
          .BackColor = IIf(NBrOpt > 0, &HFF00&, &H0&)
          .ForeColor = IIf(NBrOpt > 0, &HFF&, &HFFFF&)
     End With
End With
          Alim_Combo = TabStrSearch
End Function


Public Function StSearch(ByRef TabStrSearch As Variant) As Variant
x = 0

 For k = 1 To 6
      If k < 4 Or k = 6 Then
           x = x + 1
            With UsF_Recherche.Controls("CBx_" & x) 'avec ce combobox
        
              TabStrSearch(k, 1) = "" 'on vide la partie du tableau qui au départ contient "*"
               TabStrSearch(k, 1) = IIf(InStr(1, .Text, "< TOU") <> 0, "*", .Text)
'              TabStrSearch(k, 1) = IIf(InStr(1, .Text, "<< TOU") <> 0, "*", IIf(x > 4, Format(.Text, "00000"), .Text)) 'et on y colle ou la nouvelle valeur du Combobox
              'ou "*" si valeur contient "<TOU"
            End With
       End If
Next k
                    StSearch = TabStrSearch

End Function

 

[frederio]

'Option Explicit

Sub SupprimerLiaisons()
'par Excel-Malin.com ( https://excel-malin.com/ )
Dim Liaisons As Variant
Liaisons = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

If IsEmpty(Liaisons) = True Then Exit Sub

For LiaisonsTrouvee = 1 To UBound(Liaisons)
ActiveWorkbook.BreakLink _
    Name:=Liaisons(LiaisonsTrouvee), _
    Type:=xlLinkTypeExcelLinks
Next LiaisonsTrouvee

End Sub

 

[frederio]

Option Explicit
Option Base 1
Public Function RecupTabGen() As Variant
Set Ws_S = Worksheets(S_Name) 'on affecte la feuille "S_Name" à la variable
x = 0
With Ws_S ' à partir de cette feuille
For i = 1 To 2
 With .ListObjects("Tbl_Saison_" & i)
  DerLgn = .ListRows.Count 'on détermine la derniere ligne non vide de la premiere colonne en partant de la derniere ligne de la feuille
  DerCol = .ListColumns.Count + 1  'on détermine la derniere colonne non vide de la premiere ligne en partant
                                   'de la derniere colonne de la feuille et on y ajoute 2 colonne qui vont servir à l'indexation
   Tabtemp = .DataBodyRange.Value
 
End With
    For Lgn = 1 To UBound(Tabtemp)
    x = x + 1
        ReDim Preserve Tab_Recap(6, x)
        For Col = 1 To UBound(Tabtemp, 2)
           Tab_Recap(Col, x) = Tabtemp(Lgn, Col)
        
        Next Col
    Next Lgn
Next i
 
'on remplit le tableau temporaire avec les données de la plage ainsi déterminée
'       Tabtemp = IndexTablo(Tabtemp)  'on envoie le tableau pour indexation n° de ligne et x pour valider au départ l'ensemble des lignes
      
      'ci dessous on remplit le tableau avec les données qui vont servir au chargement des Combobox
         TabStrSearch(1, 1) = "*": TabStrSearch(1, 2) = "< TOUTES >": TabStrSearch(1, 3) = FColLsvt1      ' Colonne  1 Saisons             -------
         TabStrSearch(2, 1) = "*": TabStrSearch(2, 2) = "< TOUTES >":   TabStrSearch(2, 3) = FColLsvt2    ' Colonne  2 N             -------
         TabStrSearch(3, 1) = "*": TabStrSearch(3, 2) = "< TOUTES >":   TabStrSearch(3, 3) = FColLsvt3    ' Colonne  3 Domicile             -------
         TabStrSearch(4, 1) = "*": TabStrSearch(4, 2) = "< TOUS >":   TabStrSearch(4, 3) = FColLsvt4       ' Colonne  4 But Domicile              -------
         TabStrSearch(5, 1) = "*": TabStrSearch(5, 2) = "< TOUS >": TabStrSearch(5, 3) = FColLsvt5         ' Colonne  5 But Exterieur           -------
         TabStrSearch(6, 1) = "*": TabStrSearch(6, 2) = "< TOUTES >":   TabStrSearch(6, 3) = FColLsvt6    ' Colonne  6 Exterieur            -------

      
End With
RecupTabGen = Tab_Recap
End Function
Public Function IndexTablo(ByVal TGen As Variant) As Variant
For L = 1 To UBound(TGen, 1)
'ci dessous on en profite pour
    TGen(L, UBound(TGen, 2)) = L  'ici on entre le numero de la ligne dans la feuille source
Next
           IndexTablo = TGen
End Function

 

[frederio]

Option Explicit
Option Base 1

Sub OuvrUsfListv()
  UsF_Recherche.Show 'on affiche le Userform
End Sub


Public Function RecupListe(ByRef oLstB As MSForms.ListBox, ByVal T As Variant, ByVal TabStrSearch As Variant) As Variant
'-----------------------------------------------------------------------------
'on passe les arguments de la fonction la référence de la listView concernée
'Le Tableau Tabtemp
'et le Tableau des données des combobox
'-----------------------------------------------------------------------------
str = "" 'on vide la variable
Erase Tab_Recap
x = 0
With UsF_Recherche 'avec le Userform

'-----------------------------------------------------------------------------
'Ci dessous
  'on récupépe dans la variable l'ensemble des Données de la premiere ligne du tableau TabStrSearch soit "*!*!*!*" ou toute autre forme
  'ex "AGDE!*!*!*!*!*" dans ce cas on recherche toutes les lignes de la colonne 1 du Tableau T(=Tabtemp)qui contiennent " 1 à xxxx"
  'ex "AGDE!01/02/2016!*!*!*!*" idem ci dessus plus qui contiennent aussi en colonne 2 du Tableau T(=TabBD)
'-----------------------------------------------------------------------------
   str = TabStrSearch(1, 1) & "!" & TabStrSearch(2, 1) & "!" & TabStrSearch(3, 1) & "!" & TabStrSearch(6, 1)
     With oLstB 'avec la listBox
          .Clear 'on efface l'ensemble des données
        For L = 2 To UBound(T, 1) 'pour chaque lignes du tableau StrCompare
'-----------------------------------------------------------------------------
'Ci dessous
  'on récupépe dans la variable "StrCompare" l'ensemble des Données de la ligne considérée du tableau StrCompare soit par exemple
  '"AGDE!01/02/2016!Campement Illicite!Groupe 149!NON"
'-----------------------------------------------------------------------------
          StrCompare = T(L, 1) & "!" & T(L, 2) & "!" & T(L, 3) & "!" & T(L, 6)
'C dessous on compare les deux Variable "str" et "StrCompare" voir fonction Like
          If StrCompare Like str Then 'si StrCompare contient str
                  x = x + 1
                  
                   ReDim Preserve Tab_Recap(UBound(T, 2), x)
                  Tab_Recap(1, x) = Trim(T(L, 1))  'on colle en 1ère Colonne de la listView , la donnée qui se trouve dans la premmiere colonne
                    'de la ligne correspondante du tableau on affecte à  lvIt le ListItem ainsi ajouté
                  
             For Col = 2 To UBound(T, 2) 'on ajoute les ListSubItem
                           Tab_Recap(Col, x) = Trim(T(L, Col))  'les autres colonnes
                          
'                    End If
             Next Col 'autre colonne
                      
          End If
        
        Next L 'autre ligne
    If x = 0 Then GoTo suite
    
                 .Column = Tab_Recap
'              If .ListCount = 1 Then .ListIndex = 0
                  .Selected(1) = False      'on deselectionne la premiere ligne de la ListBox

suite:
     End With
               If NBrOpt = 3 Then 'ici on test le résultat obtenu lors du remplissage des Combobox si ensemble des choix fait "Recherche Terminée"
                   .Lbl_Info.Caption = "Résultat du Filtre   :   " & .LstB_Filtre.ListCount & "    Journée" & IIf(.LstB_Filtre.ListCount = 1, "", "s") & _
                          " Trouvée" & IIf(.LstB_Filtre.ListCount = 1, "", "s") & "   Recherche Terminée !!!!!!"
                   .Lbl_Info.ForeColor = &HFF&
                 Else
'                                  'si encore du choix "Résultat du Filtre Trouvé"
                   .Lbl_Info.Caption = "Résultat du Filtre   :   " & .LstB_Filtre.ListCount & "    Journée" & IIf(.LstB_Filtre.ListCount = 1, "", "s") & _
                          " Trouvée" & IIf(.LstB_Filtre.ListCount = 1, "", "s")
                   .Lbl_Info.ForeColor = &HFF0000
               End If

End With
End Function

 

[frederio]

Option Explicit
Public Tbl_SAISON()
Public TBl_BDD
Public TabBD
Public Lgn As Long
Public ii As Long
Public m_CmbB As Object
Public T
Public TabSearch()
Public EventOff As Boolean
Public OkClean As Boolean
Public CmboBox() As New GRCmbBOX  'déclaration d'un tableau de classe GrCmbBox qui contiendra les Combobox(s)
Public Tabtemp As Variant
Public Tab_Recap() As Variant
Public TabStrSearch(10, 3) As Variant
Public TabModif() As Variant
Public x As Long
Public DerLgn As Long
Public Ligne As Long
Public L As Long
Public Reflgn As Long
Public c As Integer
Public Col As Integer
Public Refcol_3 As Byte
Public Refcol_6 As Byte
Public k As Byte
Public NBrOpt As Byte
Public i As Integer

Public DerCol As Integer

Public Ws_S As Worksheet

Public StrCompare As String 'permet de comparer les lignes du tableau avec la de Test
Public Const StrFix As String = "*!*!*!*!*!*" 'permet la collecte de l'ensemble des donnees soi l'équivalent de "<< TOUS >>"!"<< TOUTES >>"!"<< TOUS >>"!"<< TOUTES >>"!"<< TOUS >>"!"<< TOUS >>"
Public str As String
Public Const S_Name As String = "SAISON" 'ici le nom de la feuille source

Public lviTindex As Long
Public lvSubiTindex As Integer

Public Const FColLsvt0 As String = &H0&        'ici couleur normal du  texte
Public Const FColLsvt1 As String = &HFF&       'ici couleur texte si colonne de recherche 1 "Rouge"
Public Const FColLsvt2 As String = &HFF0000    'ici 2 "bleu"
Public Const FColLsvt3 As String = &H4000&     'ici 3 "vert foncé"
Public Const FColLsvt4 As String = &HC000C0    'ici 4 "violet"
Public Const FColLsvt5 As String = &H80FF&     'ici 5 "marron"
Public Const FColLsvt6 As String = &H8080FF    'ici 6 "Rose foncé"


Public Const BColLsvt1 As String = &HFF0000
Public Const BColLsvt2 As String = &HFF&

 

[frederio]

Option Explicit

Public WithEvents GroupeCmbBox As MSForms.ComboBox 'déclaration du groupe de boutons

Private Sub GroupeCmbBox_Click()
 If EventOff = True Then Exit Sub
 Dim TBl_Tag
  OkClean = True

 With UsF_Recherche 'avec le userform
 
         Alim_Combo Tabtemp, StSearch(TabStrSearch) 'on passe en Arguments Le tableau Tabtemp (ensemble des données)
           'et le Tableau mis à jour des valeurs des combobox
            RecupListe .LstB_Filtre, Tabtemp, TabStrSearch 'on passe en Arguments la ListView ,Le tableau Tabtemp (ensemble des données)
           'et le Tableau des valeurs des combobox
 End With
 
End Sub

 

[frederio]

Option Explicit
Public Ws_Source As Worksheet


Private Sub CBn_Init_Click()
OkClean = True
If NBrOpt = 0 Then Exit Sub
NBrOpt = 0
'* ******************
 Tabtemp = Application.Transpose(RecupTabGen)             'function
'* ******************
 RecupListe UsF_Recherche.LstB_Filtre, Tabtemp, Alim_Combo(Tabtemp, TabStrSearch)
End Sub

Private Sub CBn_Quitter_Click()
Unload Me
End Sub

Private Sub UserForm_Initialise()
'Set Ws_Source = Worksheets("SAISON")
''******************************
'T = TBl_General(Ws_Source)
With UsF_Recherche
  For ii = 1 To 4 'Pour chacun des combobox de recherche
  ReDim Preserve CmboBox(1 To ii) 'on redimmensionne le tableau qui va permettre de récupéré _
                                    et d'entrer les combobox dans la Classe
    Set m_CmbB = Me.Controls("CBx_" & ii) 'on récuépere le combobox dans la variable
      m_CmbB.Tag = Choose(ii, "1", "2", "3", "6") 'on colle le numero de la colonne dans le tag du Combo
'on attribue le CmbBox au tableau de la classe GroupeCmbBox
    Set CmboBox(ii).GroupeCmbBox = m_CmbB
Next
With .LstB_Filtre
     .ColumnCount = 6
     .ColumnWidths = "80;25;175,55;45;100"
End With
'******************************
   Tabtemp = Application.Transpose(RecupTabGen)
'******************************
RecupListe .LstB_Filtre, Tabtemp, Alim_Combo(Tabtemp, TabStrSearch) 'Function
'******************************
 End With
End Sub



Private Sub CBx_1_Change()

End Sub

Private Sub CommandButton1_Click()

End Sub

Private Sub LBIi_Info_Click()

End Sub

 

[ChTi160]

Bonjour frederio
La procédure "SupprimerLiaisons()" peut être supprimée.
C'était pour régler le problème signalé.
Oh la
Je crois que je vais arrêter pourquoi mettre toutes ces procédures Dans le Fil ?
Inutile car pas d'explication.
Tu es pressé et moi je comprends pas grand chose lol

Jean marie

 

[frederio]

je ne comprends pas
vide pourquoi ?

 

[ChTi160]

Re
Normal tu n'y comprends rien !
Il ne suffit pas de copier/coller pour que ça marche !
Arrêté donc de copier du code ça ne réglera pas ton problème .
Patience
Jean marie

 

[frederio]

C’est dommage !


J’ai déçu

 

[ChTi160]

Patience !

 

[ChTi160]

Bonsoir frederio
tu as tout ces pays , ca j'ai compris Lol

Belgique Allemagne Angleterre Italie France Pays-Bas Portugal Espagne

mais les données de ces différents pays sont elles dans le même Fichier ou alors ce sont des fichiers différents ?
jean marie