Problème avec formule
Résolu
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 !
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
-
ModérateurBonjour,
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 -
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 :/-
ModérateurEt 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
-
-
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
