Methode Find date

Salut, j'ai créer un UserForm qui est censer aller rechercher dans une certaine colonne une valeur. Le code suivant marche :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Private Sub btn_Ok_Click()
Dim rc As Range, firstaddress As String, irow As Integer, nomfeuille As String, nomfeuille1 As String, _
 dl As Integer, x As Integer 'declaration des variables
 nomfeuille1 = ActiveSheet.Name
 'rechercher dans la colonne 'B' les valeurs de la TextBox
 With Sheets(nomfeuille1)
 dl = .Range("c" & Rows.Count).End(xlUp).Row
 Set rc = .Range("C1:C" & dl).Find(txtbox_typePiece)
 Application.ScreenUpdating = False
 If rc Is Nothing Then MsgBox "Il n'y a pas de correspondance": Exit Sub
 If Not rc Is Nothing Then
    'création d'une nouvelle feuille, enregistrement de son nom dans une variable et remplacement de son nom par le numero saisie dans la TextBox
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = txtbox_typePiece
    nomfeuille = ActiveSheet.Name
    'selection de la feuille d'information
    'Stockage de l'adresse dela première cellule trouvée pour ne pas boucler dessus
    firstaddress = rc.Address
    irow = 1
    For x = 2 To dl
      irow = irow + 1
      Sheets(nomfeuille).Cells(irow, 1).EntireRow.Value = rc.EntireRow.Value
      'reselection de la feuille d'information pour la suite du parcours
      Set rc = .Range("C" & rc.Row + 1, "C" & dl).Find(txtbox_typePiece)
      If rc Is Nothing Then
    Exit For
      End If
      'Si la recherche est terminée et qu l'on revient sur la première cellule trouvée, on sort.
      If rc.Address = firstaddress Then
        Exit For
      End If
    Next x
    .Activate
    MsgBox ("Le Journal a bien été copié")
 End If
 End With
 Application.ScreenUpdating = True
 Sheets(nomfeuille).Select
 Call nom_cellule
End Sub
 
Private Sub txtbox_dateCpte_Change()
 
End Sub
 
Public Sub nom_cellule()
'fonction qui va nommer les colonnes, mettrente les nom en gras et ajuster la tailel des cellules aux noms
 Range("A1").Value = "Jnal"
 Range("B1").Value = "DateCpta"
 Range("C1").Value = "TypePiece"
 Range("D1").Value = "General"
 Range("E1").Value = "TypeCpte"
 Range("F1").Value = "AuxSection"
 Range("G1").Value = "RefInterne"
 Range("H1").Value = "Libelle"
 Range("I1").Value = "ModePaie"
 Range("J1").Value = "DateEche"
 Range("K1").Value = "Sens"
 Range("L1").Value = "Montant1"
 Range("M1").Value = "TypeEcr"
 Range("N1").Value = "NumPiece"
 Range("O1").Value = "Devise"
 Range("P1").Value = "TauxDev"
 Range("Q1").Value = "CodeMontant"
 Range("R1").Value = "Montant2"
 Range("S1").Value = "Montant3"
 Range("T1").Value = "Etab"
 Range("U1").Value = "Axe"
 Range("V1").Value = "NumEche"
 Range("W1").Value = "RefExterne"
 Range("X1").Value = "DateRefExterne"
 Range("Y1").Value = "DateCreation"
 Range("Z1").Value = "Societe"
 Range("AA1").Value = "Affaire"
 Range("AB1").Value = "DatetxDevise"
 Range("AC1").Value = "EcrANouveau"
 Range("AD1").Value = "Qte1"
 Range("AE1").Value = "Qte2"
 Range("AF1").Value = "QualifQte1"
 Range("AG1").Value = "QualifQte2"
 Range("AH1").Value = "RefLibre"
 Range("AI1").Value = "TVAEnc"
 Range("AJ1").Value = "RegimeTVA"
 Range("AK1").Value = "CodeTVA"
 Range("AL1").Value = "CodeTPF"
 Range("AM1").Value = "ContrePartieGen"
 Range("AN1").Value = "ContrePartieAux"
 Range("AO1").Value = "RefPointage"
 Range("AP1").Value = "DatePointage"
 Range("AQ1").Value = "DateRelance"
 Range("AR1").Value = "DateValeur"
 Range("AS1").Value = "RIB"
 Range("AT1").Value = "RefReleve"
 Range("AU1").Value = "NumImmo"
 Range("AV1").Value = "LibreTxt0"
 Range("AW1").Value = "Libretxt1"
 Range("AX1").Value = "Libretxt2"
 Range("AY1").Value = "Libretxt3"
 Range("AZ1").Value = "Libretxt4"
 Range("BA1").Value = "Libretxt5"
 Range("BB1").Value = "Libretxt6"
 Range("BC1").Value = "Libretxt7"
 Range("BD1").Value = "Libretxt8"
 Range("BE1").Value = "Libretxt9"
 Range("BF1").Value = "Table0"
 Range("BG1").Value = "Table1"
 Range("BH1").Value = "Table2"
 Range("BI1").Value = "Table3"
 Range("BJ1").Value = "LibreMontant0"
 Range("BK1").Value = "LibreMontant1"
 Range("BL1").Value = "LibreMontant2"
 Range("BM1").Value = "LibreMontant3"
 Range("BN1").Value = "LibreDate"
 Range("BO1").Value = "LibreBool0"
 Range("BP1").Value = "LibreBool1"
 Range("BQ1").Value = "Conso"
 Range("BR1").Value = "Couverture"
 Range("BS1").Value = "CouvertureDev"
 Range("BT1").Value = "CouvertureEuro"
 Range("BU1").Value = "DatePaquetMax"
 Range("BV1").Value = "DatePaquetMin"
 Range("BW1").Value = "Lettrage"
 Range("BX1").Value = "LettrageDev"
 Range("BY1").Value = "LettrageEuro"
 Range("BZ1").Value = "EtatLettrage"
    Rows("1:1").Select
 With Selection.Characters(Start:=1, Length:=10).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
 End With
    Rows("1:1").Select
 With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
 End With
End Sub
 
Private Sub txtbox_typePiece_Change()
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub

Sauf que dans mon nouveau car la recherche s'effectue dans la colone B, ce qui me donne le code suivant :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub btn_Ok_Click()
Dim rc As Range, firstaddress As String, irow As Integer, nomfeuille As String, nomfeuille1 As String, _
 dl As Integer, x As Integer 'declaration des variables
 nomfeuille1 = ActiveSheet.Name
 'rechercher dans la colonne 'B' les valeurs de la TextBox
 With Sheets(nomfeuille1)
 dl = .Range("M" & Rows.Count).End(xlUp).Row
 Set rc = .Range("M1:M" & dl).Find(txtbox_libelle)
 Application.ScreenUpdating = False
 If rc Is Nothing Then MsgBox "Il n'y a pas de correspondance": Exit Sub
 If Not rc Is Nothing Then
    'création d'une nouvelle feuille, enregistrement de son nom dans une variable et remplacement de son nom par le numero saisie dans la TextBox
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = txtbox_libelle
    nomfeuille = ActiveSheet.Name
    'selection de la feuille d'information
    'Stockage de l'adresse dela première cellule trouvée pour ne pas boucler dessus
    firstaddress = rc.Address
    irow = 1
    For x = 2 To dl
      irow = irow + 1
      Sheets(nomfeuille).Cells(irow, 1).EntireRow.Value = rc.EntireRow.Value
      'reselection de la feuille d'information pour la suite du parcours
      Set rc = .Range("M" & rc.Row + 1, "M" & dl).Find(txtbox_libelle)
      If rc Is Nothing Then
    Exit For
      End If
      'Si la recherche est terminée et qu l'on revient sur la première cellule trouvée, on sort.
      If rc.Address = firstaddress Then
        Exit For
      End If
    Next x
    .Activate
    MsgBox ("Le Journal a bien été copié")
 End If
 End With
 Application.ScreenUpdating = True
 Sheets(nomfeuille).Select
 Call nom_cellule
End Sub

Simplement, j'ai beau rentrer n'importe quelle valeur dans la textbox, il m'affiche toujours 'aucune correspondance trouver'. Je pense que l'erreur vient du fait que dans la colonne, il s'agit d'une date au format JJMMAAAA. Dans la cellule en tout cas la date s'affiche comme sa JJMMAAAA, alors que a droite de 'fx' il s'affiche sous la forme JJ/MM/AAAA.

bonjour lilp1 le forum as tu essaye avec cdate. "fx" c 'est quoi??

Code:

Set rc = .Range("M1:M" & dl).Find(CDate(txtbox_libelle))

Bonjour, merci de l'intéret que tu portes a mon probleme.
Le 'fx' est afficher sous le menu, dedans on voit la formule ou le texte de la celulle selectionner.
Ta formule fonctionne bien, il faut que je tappe la date au format JJ/MM/AAAA.
Par contre, le nom d'une feuille ne pas contenir des "/". Saurrait-tu comment je pourrais faire pour que la valeur que je tappe dans ma TextBox pour exemple : "10/01/2005", lorsque je souhaite renommer la nouvelle feuille creer, il enleve les "/"?

re essai avec la fonction replace pour nommer ta feuille

Code:

txtbox_libelle.Value = Replace(txtbox_libelle.Value, "/", "")

Ouais merci, sa marche comme sa. Par contre, je ne comprend, il me zappe a chaque fois une ligne, j'ai par exemple 4enregistrements qui correspondent a ma recherche et in le m'en copie que 3, plus bizarre encore, il ne zappe ni le premier ni le dernier mais un enregistrement au milieu, dans le cas de mon test, il zappe le 2eme

re, comme cela je vois pas il faudrait que tu zip une partie du fichier pour approfondir

Heu, je suis désolé, mais je ne peut pas t'envoyer le fichier, car je suis en entreprise et je n'ai pas le droit de divulguer des informations. Mais voici des captures d'écrans :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub btn_Ok_Click()
Dim rc As Range, firstaddress As String, irow As Integer, nomfeuille As String, nomfeuille1 As String, _
 dl As Integer, x As Integer 'declaration des variables
 nomfeuille1 = ActiveSheet.Name
 'rechercher dans la colonne 'B' les valeurs de la TextBox
 With Sheets(nomfeuille1)
 dl = .Range("b" & Rows.Count).End(xlUp).Row
 Set rc = .Range("B1:B" & dl).Find(CDate(txtbox_dateCpta))
 Application.ScreenUpdating = False
 If rc Is Nothing Then MsgBox "Il n'y a pas de correspondance": Exit Sub
 If Not rc Is Nothing Then
    'création d'une nouvelle feuille, enregistrement de son nom dans une variable et remplacement de son nom par le numero saisie dans la TextBox
    Sheets.Add After:=Worksheets(Worksheets.Count)
    nomfeuille = ActiveSheet.Name
    'selection de la feuille d'information
    'Stockage de l'adresse dela première cellule trouvée pour ne pas boucler dessus
    firstaddress = rc.Address
    irow = 1
    For x = 2 To dl
      irow = irow + 1
      Sheets(nomfeuille).Cells(irow, 1).EntireRow.Value = rc.EntireRow.Value
      'reselection de la feuille d'information pour la suite du parcours
      Set rc = .Range("B" & rc.Row + 1, "B" & dl).Find(CDate(txtbox_dateCpta))
      If rc Is Nothing Then
    Exit For
      End If
      'Si la recherche est terminée et qu l'on revient sur la première cellule trouvée, on sort.
      If rc.Address = firstaddress Then
        Exit For
      End If
    Next x
    .Activate
    MsgBox ("Le Journal a bien été copié")
 End If
 End With
 Application.ScreenUpdating = True
 Sheets(nomfeuille).Select
 txtbox_dateCpta.Text = Replace(txtbox_dateCpta.Text, "/", "")
 ActiveSheet.Name = txtbox_dateCpta
 nomfeuille = ActiveSheet.Name
 Call nom_cellule
End Sub

re desole je comprends pas j ai du mal a reproduire ton code
tu peus pas faire un ex: avec un user une textbox un bouton 2 ou trois feuilles
avec des données bidons & resultat excompte sur tes feuilles!!!!!!