XL 2016 Aide pour userform (sujet clos)

tactic6

XLDnaute Impliqué
Bonjour à tous les userforms c'est vraiment pas mon fort et j'aimerai (encore une fois) votre aide
voici la macro qui rempli ma feuille ShArchive:

Sub Transfert()
Dim Ligne As Long
Dim colonne As Long
Dim Cellule As Range
Dim lg
Dim Derli As Long
Dim i As Long, sStr As String, Ar() As String
'Application.ScreenUpdating = False
Sheets("SAISIE").Select
Sheets("ShArchive").Visible = True

sStr = "I6,I5,C12,G8,H9,G10,h12,B15,C15,H15,I15,J15,K15,B16,C16,H16,I16,J16,K16," & _
"B17,C17,H17,I17,J17,K17,B18,C18,H18,I18,J18,K18,B19,C19,H19,I19,J19,K19," & _
"B20,C20,H20,I20,J20,K20,B21,C21,H21,I21,J21,K21,B22,C22,H22,I22,J22,K22," & _
"B23,C23,H23,I23,J23,K23,B24,C24,H24,I24,J24,K24,B25,C25,H25,I25,J25,K25," & _
"B26,C26,H26,I26,J26,K26,B27,C27,H27,I27,J27,K27,B28,C28,H28,I28,J28,K28," & _
"B29,C29,H29,I29,J29,K29,B30,C30,H30,I30,J30,K30,B31,C31,H31,I31,J31,K31," & _
"B32,C32,H32,I32,J32,K32,B33,C33,H33,I33,J33,K33,B34,C34,H34,I34,J34,K34," & _
"B35,C35,H35,I35,J35,K35,B36,C36,H36,I36,J36,K36,B40,C40,H40,I40,J40,K40," & _
"B37,C37,H37,I37,J37,K37,B38,C38,H38,I38,J38,K38,B39,C39,H39,I39,J39,K39," & _
"B41,C41,H41,I41,J41,K41,B42,C42,H42,I42,J41,K42,B43,C43,H43,I43,J43,K43," & _
"B44,C44,H44,I44,J44,K44,B45,C45,H45,I45,J45,K45,B46,C46,H46,I46,J46,K46," & _
"B47,C47,H47,I47,J47,K47,B48,C48,H48,I48,J48,K48,B49,C49,H49,I49,J49,K49," & _
"B50,C50,H50,I50,J50,K50,B51,C51,H51,I51,J51,K51,B52,C52,H52,I52,J52,K52," & _
"B53,C53,H53,I53,J53,K53,B54,C54,H54,I54,J54,K54,B55,C55,H55,I55,J55,K55," & _
"B56,C56,H56,I56,J56,K56,B57,C57,H57,I57,J57,K57,B58,C58,H58,I58,J58,K58," & _
"J60,B61,B62,B63,C61,C62,C63,D61,D62,D63,F64,F65,J61,J62,J63,J64,j65"

Ar = Split(sStr, ",")
Ligne = Worksheets("ShArchive").Range("A" & Rows.Count).End(xlUp).Row + 1

lg = Application.Match(Range(Ar(0)), Sheets("ShArchive").Range("A1:A" & Ligne), 0)

' Si erreur : Pas de doublon
' sinon Lg contient la ligne en double
If Not IsError(lg) Then


Ligne = lg

End If

' Remplit les colonnes
For i = LBound(Ar) To UBound(Ar)
colonne = colonne + 1
Worksheets("ShArchive").CellS(Ligne, colonne) = Worksheets("SAISIE").Range(Ar(i))
Next i
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

End Sub

Je voudrais créer un userform avec
une Private Sub ComboBox1_Click()
une combobox ou je selectionne le nom du client ( colonne D de ShArchive) sans doublon en faisant une recherche intuitive


une Private Sub TextBox1_Click()
une TextBox qui recherche un mot dans la plage (B15:K52) correspondant au nom inscrit dans la ComboBox1 avec ou sans majuscule il se peut qu'il y ait des cellules vides et des chiffres
la recherche doit être (si possible) intuitive
et que le résultat s'affiche dans la Feuil"résultats" quand je clic sur CommandButton1
Merci d'avance
Voici ce que j'ai essayer de faire mais vous vous doutez bien que rien ne fonctionne
VB:
Option Explicit

Private Sub UserForm_Initialize()
    ' Appelé lorsque le UserForm est initialisé

    ' Remplir la ComboBox avec les noms de clients uniques de la colonne D de ShArchive
    FillComboBox
End Sub

Private Sub FillComboBox()
    ' Remplit la ComboBox avec les noms de clients uniques de la colonne D de ShArchive

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim clientNames As Collection
    Dim cell As Range
    Dim client As Variant ' Ajout de cette ligne pour déclarer la variable client

    Set ws = ThisWorkbook.Sheets("ShArchive") ' Assurez-vous que le nom de la feuille est correct
    Set clientNames = New Collection

    ' Parcourir la colonne D et ajouter les noms de clients uniques à la collection
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    For Each cell In ws.Range("D2:D" & lastRow)
        If cell.Value <> "" And Not IsInCollection(clientNames, cell.Value) Then
            clientNames.Add cell.Value
        End If
    Next cell

    ' Remplir la ComboBox avec les noms de clients uniques
    For Each client In clientNames
        ComboBox1.AddItem client
    Next client
End Sub

Private Function IsInCollection(col As Collection, val As Variant) As Boolean
    ' Vérifie si une valeur est déjà dans la collection

    On Error Resume Next
    col.Add val, CStr(val)
    IsInCollection = (Err.Number = 0)
    On Error GoTo 0
End Function

Private Sub ComboBox1_Click()
    ' Appelé lorsqu'un élément est sélectionné dans la ComboBox

    ' Mettez ici le code pour traiter la sélection dans la ComboBox
    ' Par exemple, vous pouvez récupérer la valeur sélectionnée avec ComboBox1.Value
    ' et effectuer les actions nécessaires avec cette valeur.
End Sub

Private Sub TextBox1_Change()
    ' Appelé lorsqu'il y a un changement dans la TextBox

    ' Filtrer les noms de clients dans la ComboBox en fonction de la saisie dans la TextBox
    FilterNames TextBox1.Value
End Sub

Private Sub FilterNames(filterText As String)
    ' Filtrer les noms de clients dans la ComboBox en fonction du texte filtré

    Dim client As Variant
    Dim filteredList As New Collection

    ' Filtrer les noms de clients en fonction du texte filtré
    For Each client In ComboBox1.List
        If InStr(1, client, filterText, vbTextCompare) > 0 Then
            filteredList.Add client
        End If
    Next client

    ' Effacer la ComboBox
    ComboBox1.Clear

    ' Remplir la ComboBox avec les noms filtrés
    For Each client In filteredList
        ComboBox1.AddItem client
    Next client
End Sub

Private Sub btnSearch_Click()
    ' Appelé lorsqu'on clique sur le bouton de recherche

    ' Mettez ici le code pour traiter la recherche
    ' Par exemple, vous pouvez récupérer la valeur entrée avec TextBox1.Value
    ' et effectuer les actions nécessaires avec cette valeur.
    MsgBox "Effectuer la recherche pour : " & TextBox1.Value
End Sub

j'aurais bien mis un fichier exemple mais la plage est vraiment enorme
 
Dernière édition:

tactic6

XLDnaute Impliqué
Bonjour voici un petit fichier décrivant ma recherche pour pour votre aide
Capture.JPG
 

Pièces jointes

  • Classeur1.xlsm
    108.3 KB · Affichages: 2

Discussions similaires

Statistiques des forums

Discussions
312 860
Messages
2 092 960
Membres
105 570
dernier inscrit
aitj