Manipulation avec double itération et deux feuilles de données - Je cale

Bonjour à tous,

Après une soirée infructueuse je fais appelle à votre communauté pour m'aider dans mon script, merci à qui pourra m'aider

Je dois réaliser une manipulation dans une base de données Excel:

Je dois comparer des données texte de chaque ligne d'une colonne (de 50 lignes) avec une autre colonne de 369 lignes (contenant à chaque fois un mot), et qui se trouve dans une autre sheet.

Si un des mots de la deuxième colonne (variable xvar) est compris dans le texte de la première colonne (variable ivar) alors,

j'aimerai attribuer ce mot à une cellule d'une troisième colonne sur la première sheet (en vis à vis de la ligne de la première colonne correspondante donc).

J'utilise donc deux variables pour se faire (pour la première colonne une variable ivar, et pour la deuxième colonne une variable xvar).

Et j'utilise la fonction InStr pour voir si le mot matche avec le texte.

J'espère avoir été le plus clair possible,

et un grand merci à qui pourra me donner un coup de main!

VBAment vôtre,

Jean

Sub Macro1()
'
' Macro1 Macro
'
Dim ivar As String
Dim xvar As String

Dim i As Integer
Dim x As Integer

For i = 2 To 50
    Sheets("MasterDATA").Activate
    ivar = Cells(i, 82).Value
    For x = 2 To 369
        Sheets("Elements EHS").Activate
        xvar = Cells(x, 4).Value
        If InStr(1, (ivar), (xvar), 1) <> 0 Then
            Sheets("MasterDATA").Activate
            Cells(i, 88).Value = xvar
            End If
        Next x
    Next i

End Sub

à noter que le script ne bug pas, mais il n'y a aucun résultat :s

Finalement il y a un résultat! En lançant la macro directement par Excel j'arrive à avoir un résultat ;)

mais ce n'est clairement pas optimiser, et je vous avoue que j'aimerai analyser un fichier de 300 000 lignes avec ce macro.

Si qq'un a des idées pour optimiser je suis preneur:)

Bonjour,

as-tu un extrait de ton fichier ?

Bonjour Steelson,

oui, voici le fichier en question. avec et sans la macro

Sub Macro1()
'
' Macro1 Macro
'
Dim ivar As String
Dim xvar As String

Dim i As Integer
Dim x As Integer

For i = 2 To 50
    Sheets("MasterDATA").Activate
    ivar = Cells(i, 1).Value
    For x = 2 To 50
        Sheets("Elements EHS").Activate
        xvar = Cells(x, 1).Value
        If InStr(1, (ivar), (xvar), 1) <> 0 Then
            Sheets("MasterDATA").Activate
            Cells(i, 2).Value = xvar
            End If
        Next x
    Next i

End Sub

Et voici le code correspondant à l'exemple.

Merci pour toute aide!

Une proposition (j'ai ajouté une ligne en jaune pour ne pas arrêter la macro)

Sub correspondance()
Dim dico As Object, result()

    Set dico = CreateObject("Scripting.Dictionary")

    tblFHS = Sheets("Elements EHS").Cells(1, 1).CurrentRegion.Value
    For i = 2 To UBound(tblFHS)
        tblFHS(i, 1) = Replace(tblFHS(i, 1), "’", " ")
        tblFHS(i, 1) = Replace(tblFHS(i, 1), "(", " ")
        tblFHS(i, 1) = Replace(tblFHS(i, 1), ")", " ")
        mots = Split(tblFHS(i, 1) & " ", " ")
        For j = LBound(mots) To UBound(mots)
            If Len(mots(j)) > 2 Then dico(UCase(mots(j))) = ""
        Next
    Next

    tblDATA = Sheets("MasterDATA").Cells(1, 1).CurrentRegion.Value
    ReDim result(1 To UBound(tblDATA))
    result(1) = "éléments critiques"
    For i = 2 To UBound(tblDATA)
        For Each cle In dico
            If UCase(tblDATA(i, 1)) Like "*" & cle & "*" Then result(i) = result(i) & cle & "|"
        Next
    Next

    Sheets("MasterDATA").Cells(1, 2).Resize(UBound(result), 1) = Application.Transpose(result)

End Sub

Un bien beau code que tu m'as écrit Steelson, un grand merci à toi.

Je vais prendre le temps de bien comprendre les différentes fonctions que tu as utilisées, mais le code fonctionne bien comme il le devrait (bien mieux qu'à ma manière).

Une excellente soirée à toi:)

Jean

L'esprit du code est de créer un dictionnaire de tous les mots de plus de 2 lettres, en majuscule pour éviter des oublis ensuite !

Je prends ensuite chaque "phrase" dans laquelle je recherche chacun des mots par like avec des astérisques.

Je n'ai pas réussi à enlever les apostrophes (curieux !), mais j'ai enlevé les parenthèses.