Problème avec formule
Résolu
pzyko
Messages postés
35
Statut
Membre
-
pzyko Messages postés 35 Statut Membre -
pzyko Messages postés 35 Statut Membre -
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 !
A voir également:
- Problème avec formule
- Formule si et - Guide
- Formule moyenne excel plusieurs colonnes - Guide
- Formule mathématique - Télécharger - Études & Formations
- Excel mise en forme conditionnelle formule - Guide
- Formule somme excel colonne - Guide
3 réponses
Bonjour,
Essaie ceci :
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
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 :
Cela fonctionne mais le problème c'est que je n'arrive pas à mettre plusieurs mots cibles :/
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 :/
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
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 :
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