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
j'aurais bien mis un fichier exemple mais la plage est vraiment enorme
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: