Problème avec formule

Résolu
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 !

3 réponses

  1.
    pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
  2. pzyko Messages postés 35 Statut Membre 1
     
    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
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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
  3. pzyko Messages postés 35 Statut Membre 1
     
    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

exo pix
Xtyller -
Raymond PENTIER -

2 réponses
formuler Z10 SE bloqué.
robigeo -
CCMBot -

1 réponse
Problème formuler Z 10
Libouban -
Peperoni -

3 réponses