Discussion :

[cedric59dk]

Bonjour tout le monde,

J'ai une question à vous poser.

Es t'il possible d'utiliser la reconnaissance de texte pour lancer une macro...

Je m'explique :

Dans un fichier Excel lorsque l'on remplit une cellule par « Kokola », si l'on va dans une autre cellule et que l'on met « kok », il nous demande si l'on veut mettre la même chaine de caractères dans la cellule.

Je souhaiterai lancer une macro si l'utilisateur valide la même donnée dans la cellule je copie l'ensemble de la ligne et je la colle.

Je vous remercie de toute l'aide que vous m'apporterez.

Salutations.

[ouskel'n'or]

J'aime bien les problèmes tordus et là, comme j'en vois un se profiler à l'horizon...
Oui, c'est possible, reste plus qu'à voir si ce ne sera pas une usine à gaz...
Si les données saisies sont toujours dans la même colonne, c'est facile.
Tu places ton code dans l'événement Change de la feuille de calculs
Là tu récupères "Target", qui est la donnée qui vient d'être saisie, et son adresse (Target.Address)
Ensuite, tu fais une recherche dans la feuille de calculs pour voir si elle existe déjà à une autre adresse, et si c'est le cas, tu copies la ligne Target.row là où tu veux la mettre.
Ex :

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
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Column = 6 Then Exit Sub 'si ce n'est pas la bonne colonne, on sort
Dim Adresse As String, firstAddress As String
Dim c As Range
    With ActiveSheet.Cells 'Plage de recherche : ici la feuille complète
        Set c = .Find(Target, LookIn:=xlValues) 'recherche de la donnée saisie
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                If c.Address <> Adresse Then
                    'colle ta ligne sur la ligne 80 de la même feuille
                    Target.EntireRow.Copy Range("A80") ' à adapter
                    Exit Do
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

[cafeine]

Hello,

j'ai fait un truc qui semble marcher

j'ai mis sur une colonne une règle de validation qui permet de proposer une liste déroulante des dernières valeurs

et le code suivant

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
Dim r As Range, c As Range
 
On Error GoTo errValidation
If Target.Validation.Type <> 0 Then
    Set r = Range(Mid(Target.Validation.Formula1, 2))
    For Each c In r.Cells
        If c = Target Then
            c.EntireRow.Copy Target
            Exit For
        End If
    Next c
End If
 
GoTo exitFin
 
errValidation:
Select Case Err.Number
    Case 1004
        ' pas de règle de validation ne rien faire
        Err.Clear
 
    Case Else
        MsgBox "erreur non prévue" & vbCrLf & "Erreur n° " & Err.Number & vbCrLf & _
                Err.Description, vbCritical + vbOKOnly, "Erreur"
        Err.Clear
 
End Select
 
exitFin:
Set r = Nothing
Set c = Nothing
End Sub

[cedric59dk]

Hello,

j'ai fait un truc qui semble marcher

j'ai mis sur une colonne une règle de validation qui permet de proposer une liste déroulante des dernières valeurs

et le code suivant

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
Dim r As Range, c As Range
 
On Error GoTo errValidation
If Target.Validation.Type <> 0 Then
    Set r = Range(Mid(Target.Validation.Formula1, 2))
    For Each c In r.Cells
        If c = Target Then
            c.EntireRow.Copy Target
            Exit For
        End If
    Next c
End If
 
GoTo exitFin
 
errValidation:
Select Case Err.Number
    Case 1004
        ' pas de règle de validation ne rien faire
        Err.Clear
 
    Case Else
        MsgBox "erreur non prévue" & vbCrLf & "Erreur n° " & Err.Number & vbCrLf & _
                Err.Description, vbCritical + vbOKOnly, "Erreur"
        Err.Clear
 
End Select
 
exitFin:
Set r = Nothing
Set c = Nothing
End Sub

Merci beaucoup, je n'avais pas pensé à utiliser cette méthode et je la trouve très intéressante.
Ton aide est précieuse à tout le monde.
Encore merci

[cedric59dk]

J'ai une petite question à te poser, comment as tu fais pour ne pas appliquer la liste déroulante sur les 3 premiére lignes de la feuille?

Merci de ton aide !

[cedric59dk]

Je me suis mal exprimé...

J'ai compris l'histoire de la régle de validation. Mais si je souhaite par exemple l'appliquer à toutes les cellules sauf A1 et A2 mais à la suite de la colonne oui.

Meric

[cafeine]

Hé bien au moment de définir la règle de validation, je ne sélectionne que A3:A65536

[cedric59dk]

J'aime bien les problèmes tordus et là, comme j'en vois un se profiler à l'horizon...
Oui, c'est possible, reste plus qu'à voir si ce ne sera pas une usine à gaz...
Si les données saisies sont toujours dans la même colonne, c'est facile.
Tu places ton code dans l'événement Change de la feuille de calculs
Là tu récupères "Target", qui est la donnée qui vient d'être saisie, et son adresse (Target.Address)
Ensuite, tu fais une recherche dans la feuille de calculs pour voir si elle existe déjà à une autre adresse, et si c'est le cas, tu copies la ligne Target.row là où tu veux la mettre.
Ex :

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
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Column = 6 Then Exit Sub 'si ce n'est pas la bonne colonne, on sort
Dim Adresse As String, firstAddress As String
Dim c As Range
    With ActiveSheet.Cells 'Plage de recherche : ici la feuille complète
        Set c = .Find(Target, LookIn:=xlValues) 'recherche de la donnée saisie
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                If c.Address <> Adresse Then
                    'colle ta ligne sur la ligne 80 de la même feuille
                    Target.EntireRow.Copy Range("A80") ' à adapter
                    Exit Do
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

Actuellement j'utilise un code similaire à celui-ci mais le probléme est la rapidité d'éxécution sur une feuille assez importante!

Je te remercie de ton aide... et je te remercie de l'aide que tu apporte à de nombreuses personnes.