Recherche de mot similaire

**Kylou_lou** · 31/05/2024, 11h44

Voici mon code en VBA excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton1_Click()
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
 
    ' Remplir les cellules de Feuil1
    With Feuil1
        .Range("D1").Value = NomClient
        .Range("D2").Value = N°Projet
        .Range("D3").Value = ChefDeProjet
    End With
 
    Dim Plage As Range
    Dim LigneTrouvee As Long
    Dim ws As Worksheet
    Dim numero As Integer
    Dim checkbox As MSForms.checkbox
    Dim Capcheck As String
    Dim NCheck As Object
 
    ' Copier les données de Feuil2 à FeuilleDestination
    Set ws = ThisWorkbook.Sheets(1)
    Feuil2.Range("A9:AQ300").Copy Destination:=ws.Range("A9")
 
    numero = 1
    Do While numero < 24
 
        ' Accéder au CheckBox en utilisant le nom
        Set checkbox = Me.Controls("CheckBox" & numero)
 
        'lire la propriété Caption de la CheckBox
        Capcheck = checkbox.Caption
 
                  If checkbox = False Then
            ' Rechercher le mot clé dans la colonne A
            Set Plage = Sheets(1).Columns("A").Find(What:=Capcheck, LookIn:=xlValues, LookAt:=xlPart)
 
            If Not Plage Is Nothing Then
                ' Obtenir le numéro de ligne où le mot clé a été trouvé
                LigneTrouvee = Plage.Row
 
                ' Sélectionner les lignes suivantes jusqu'à ce qu'une cellule ne contienne pas un nombre
                Dim i As Long
                For i = LigneTrouvee + 1 To Rows.Count
                    If Not IsNumeric(Sheets(1).Cells(i, "A").Value) Then
                        Exit For
                    End If
                Next i
 
                ' Supprimer les lignes de la plage de cellules trouvée
                Feuil1.Range("A" & LigneTrouvee & ":AI" & i - 1).EntireRow.Delete
            End If
       End If
        numero = numero + 1
    Loop
 
    ' Fermer la UserForm
    Me.Hide
 
    ' Renommer la feuille
    ws.Name = "ARDM_" & NomClient
 
    ' Masquer une feuille spécifique
    ThisWorkbook.Sheets("Général").Visible = xlSheetHidden
    ThisWorkbook.Sheets("Listes").Visible = xlSheetHidden
 
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

Mon problème c'est que j'ai des mots similares comme café et café au lait dans les valeurs que peuvent prendre CapCheck.
Et donc quoi que je coche dans mes checkbox j'ai toujours les ligne relative à café qui apparaissent.

Pouvez-vous m'aider ?