Sujet Précédent Sujet Suivant

Problème avec formule

Résolu/Fermé
pzyko Messages postés 34 Date d'inscription vendredi 27 juin 2014 Statut Membre Dernière intervention 8 août 2014 - 8 juil. 2014 à 10:26
pzyko Messages postés 34 Date d'inscription vendredi 27 juin 2014 Statut Membre Dernière intervention 8 août 2014 - 8 juil. 2014 à 11:56
Bonjour,

J'ai un classeur excel avec une feuille 1 contenant mes données. J'aimerais trouver un code dans VBA qui aille rechercher dans chaque cellule de la colonne F de cette feuille si des mots cibles sont contenus dans ces cellules. Ensuite, j'aimerais que si un des mots cibles est contenu dans la cellule F2 (par exemple), que la valeur 1 apparaisse dans la cellule A2 de ma seconde feuille et s'il ne trouve pas de mot cible, qu'il y mette la valeur 0.

Pour cela, j'ai créé un code VBA qui permet d'insérer une formule dans ma feuille 2. Toutefois, ce que j'aimerais, c'est trouver un code VBA qui me permette de mettre directement la valeur 0 ou 1 au lieu d'insérer la formule.

Voici le code que j'ai créé :

Sub recherche_multiple()


Dim derLigne As Long
Dim plageA, plageB, plageC, plageD As Range

With Sheets("Feuil1")

derLigne = .Range("F" & .Rows.Count).End(xlUp).Row

End With


Set plageA = Sheets("Feuil2").Range("A2:A" & derLigne)
plageA.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""chien"",Feuil1!RC6))),1,IF(NOT(ISERROR(FIND(""serpent"",Feuil1!RC6))),1,0))"

Set plageB = Sheets("Feuil2").Range("B2:B" & derLigne)
plageB.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""poisson"",Feuil1!RC6))),1,IF(NOT(ISERROR(FIND(""chat"",Feuil1!RC6))),1,0))"

Set plageC = Sheets("Feuil2").Range("C2:C" & derLigne)
plageC.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""panda"",Feuil1!RC6))),1,IF(NOT(ISERROR(FIND(""oiseau"",Feuil1!RC6))),1,IF(NOT(ISERROR(FIND(""tortue"",Feuil1!RC6))),1,0)))"

Set plageD = Sheets("Feuil2").Range("D2:D" & derLigne)
plageD.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""cheval"",Feuil1!RC6))),1,IF(NOT(ISERROR(FIND(""vache"",Feuil1!RC6))),1,0))"


End Sub


Je n'ai peut-être pas été clair alors je vous fourni un excemple qui montre clairement ce que je chercher à faire avec cette formule : https://www.cjoint.com/?0Gikya94oTk

Merci à vous !

3 réponses

Réponse 1 / 3
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
Modifié par pijaku le 8/07/2014 à 11:10
Bonjour,

Essaie ceci : 
Sub UnZero()
Dim i As Long
Dim Feuil1 As Worksheet, Feuil2 As Worksheet
Dim MesDonnees()

Set Feuil1 = Worksheets("Feuil1") 'A adapter le nom de la feuille
Set Feuil2 = Worksheets("Feuil2") 'A adapter le nom de la feuille

MesDonnees = Feuil1.Range("F1:F" & Feuil1.Range("F" & Rows.Count).End(xlUp).Row)

For i = LBound(MesDonnees) To UBound(MesDonnees)
    'test chien serpent
    If MesDonnees(i, 1) Like "*chien*" Or MesDonnees(i, 1) Like "*serpent*" Then
        Feuil2.Range("A" & i) = 1
    Else
        Feuil2.Range("A" & i) = 0
    End If
    'test poisson chat
    If MesDonnees(i, 1) Like "*poisson*" Or MesDonnees(i, 1) Like "*chat*" Then
        Feuil2.Range("B" & i) = 1
    Else
        Feuil2.Range("B" & i) = 0
    End If
    'test panda oiseau tortue
    If MesDonnees(i, 1) Like "*panda*" Or MesDonnees(i, 1) Like "*oiseau*" Or MesDonnees(i, 1) Like "*tortue*" Then
        Feuil2.Range("D" & i) = 1
    Else
        Feuil2.Range("D" & i) = 0
    End If
    'test cheval vache
    If MesDonnees(i, 1) Like "*cheval*" Or MesDonnees(i, 1) Like "*vache*" Then
        Feuil2.Range("C" & i) = 1
    Else
        Feuil2.Range("C" & i) = 0
    End If
Next i
End Sub


Edit : il y a des possibilités d'amélioration et d'adaptations.
Donc, en attente de votre retour....

Vergesst nicht : Wer Unrecht lange geschehen lässt, bahnt dem nächsten den Weg. »
14 septembre 1992,Willy Brandt
1
Réponse 2 / 3
pzyko Messages postés 34 Date d'inscription vendredi 27 juin 2014 Statut Membre Dernière intervention 8 août 2014 1
Modifié par pijaku le 8/07/2014 à 12:00
Je ne vois que cette partie de ton code :

Sub UnZero() Dim i As Long Dim Feuil1 As Worksheet, Feuil2 As Worksheet Dim MesDonnees

:/

Entre temps, j'ai essayé quelquechose qui me semble pas mal : 

Sub recherche_multiple()

Dim cible As String
Dim i As Integer
Dim derLigne As Long


 With Sheets("Feuil1")
    
    
        derLigne = .Range("F" & .Rows.Count).End(xlUp).Row
        
   End With

cible = "chien"

For i = 2 To derLigne

If InStr(Sheets("Feuil1").Cells(i, 6).Value, cible) = 0 Then

Sheets("Feuil2").Cells(i, 1).Value = 0

Else: Sheets("Feuil2").Cells(i, 1).Value = 1

End If

Next i


End Sub



Cela fonctionne mais le problème c'est que je n'arrive pas à mettre plusieurs mots cibles :/
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
8 juil. 2014 à 11:37
Et là, vois tu tout le code ? 

Sub UnZero()
Dim i As Long
Dim Feuil1 As Worksheet, Feuil2 As Worksheet
Dim MesDonnees()

Set Feuil1 = Worksheets("Feuil1") 'A adapter le nom de la feuille
Set Feuil2 = Worksheets("Feuil2") 'A adapter le nom de la feuille

MesDonnees = Feuil1.Range("F1:F" & Feuil1.Range("F" & Rows.Count).End(xlUp).Row)

For i = LBound(MesDonnees) To UBound(MesDonnees)
    'test chien serpent
    If MesDonnees(i, 1) Like "*chien*" Or MesDonnees(i, 1) Like "*serpent*" Then
        Feuil2.Range("A" & i) = 1
    Else
        Feuil2.Range("A" & i) = 0
    End If
    'test poisson chat
    If MesDonnees(i, 1) Like "*poisson*" Or MesDonnees(i, 1) Like "*chat*" Then
        Feuil2.Range("B" & i) = 1
    Else
        Feuil2.Range("B" & i) = 0
    End If
    'test panda oiseau tortue
    If MesDonnees(i, 1) Like "*panda*" Or MesDonnees(i, 1) Like "*oiseau*" Or MesDonnees(i, 1) Like "*tortue*" Then
        Feuil2.Range("D" & i) = 1
    Else
        Feuil2.Range("D" & i) = 0
    End If
    'test cheval vache
    If MesDonnees(i, 1) Like "*cheval*" Or MesDonnees(i, 1) Like "*vache*" Then
        Feuil2.Range("C" & i) = 1
    Else
        Feuil2.Range("C" & i) = 0
    End If
Next i
End Sub
0
Réponse 3 / 3
pzyko Messages postés 34 Date d'inscription vendredi 27 juin 2014 Statut Membre Dernière intervention 8 août 2014 1
Modifié par pijaku le 8/07/2014 à 12:00
Un grand merci pour ta réponse rapide. Je vais tester ce code de suite.

Entre temps, j'avais pu trouver une solution qui semble fonctionner aussi : 

Sub rechmult()

Dim cible, cible2 As String
Dim i As Integer
Dim derLigne As Long

 With Sheets("Feuil1")    
        derLigne = .Range("F" & .Rows.Count).End(xlUp).Row        
  End With

cible = "chien"
cible2 = "serpent"

For i = 2 To derLigne

If InStr(1, Sheets("Feuil1").Cells(i, 6), cible) = 0 And InStr(1, Sheets("Feuil1").Cells(i, 6), cible2) = 0 Then

Sheets("Feuil2").Cells(i, 1).Value = 0

Else: Sheets("Feuil2").Cells(i, 1).Value = 1

End If

Next i

End Sub
0

Discussions similaires

je veut créer des codes
jonkiller -
Nhhi -

20 réponses
exo pix
Xtyller -
Raymond PENTIER -

2 réponses
Formule Excel : "SI" une cellule contient un mot, alors ?
Tonio5933 -
Mike-31 -

9 réponses