Comment rendre la boucle imbriquée plus rapide pour trouver un instr dans vba

Description du problème: Parcourez Excel rangées maximum (environ 10000000) pour trouver l’instr. Après avoir trouvé un instrument, prenez les valeurs et copiez-les dans une autre feuille. Chaque fois que vous recherchez la correspondance qui est instr, copiez la valeur uniquement les correspondances et collez-la sur une feuille différente.

Problème: J'utilise une boucle imbriquée et ma boucle est lente. Pour 10 millions de lignes, cela prend environ 19:37 minutes. Je l'ai chronométré. Donc, première question, existe-t-il différentes façons de le faire ou comment accélérer le processus au lieu de 20 minutes? Est-il possible de comparer 20 millions (chaque feuille, 10 millions de lignes, 10 millions de chaînes) en une minute ou deux? Voici mon code actuel

  Sub zym()
   Dim x As Long, lastrow As Long, lastrowx As Long, i As Long, ii As Long
   Dim ws As Worksheet, ws2 As Worksheet, b As String
   Dim j As Long

   Set ws = Worksheets("Sheet1")
   Set ws2 = Worksheets("Sheet2")
   Set ws3 = Worksheets("Sheet3")
   j = 1
      T1 = GetTickCount

  lastrow = ws.UsedRange.Rows.Count + 1
  lastrowx = ws2.UsedRange.Rows.Count + 1

   ReDim sheet1array(1 To lastrow)
   ReDim sheet2array(1 To lastrowx)

    For i = LBound(sheet1array) To UBound(sheet1array)
        b = "-" & ws.Range("A" & i) & "-"
      For ii = LBound(sheet2array) To UBound(sheet2array)
        If InStr(1, ws2.Range("A" & ii), b) > 0 Then
        ws3.Range("A" & j) = ws2.Range("A" & ii)
        j = j + 1
        End If

       Next ii
     Next i
    Debug.Print "Array Time = " & (GetTickCount - T1) / 1000#
    Debug.Print "Array Count = " & Format(ii, "#,###")

End Sub

La lecture et l'écriture de cellules sur une feuille ralentissent toute macro. Le code suivant copie les valeurs de cellule dans des tableaux et les parcourt. La sortie est copiée en morceaux d'un tableau de résultats dans la feuille cible.
Sur mon cahier, le code original prenait 56 secondes, le code suivant était de 3,7 secondes:

Sub zym2()
    Dim lastrow As Long, i As Long, j As Long, start As Long
    Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim b As String
    Dim T1 As Long
    Dim arr1, arr2, arr3, c

    Set ws = Worksheets("sh1")
    Set ws2 = Worksheets("sh2")
    Set ws3 = Worksheets("sh3")
    ws3.Columns(1).Clear
    T1 = Timer

    arr1 = Intersect(ws.Columns(1), ws.UsedRange)
    lastrow = UBound(arr1)
    arr2 = ws2.UsedRange
    ReDim arr3(1 To lastrow / 10, 2)   ' initial length is arbitrary

    j = 0
    start = 1
    For i = 1 To lastrow
        b = "-" & arr1(i, 1) & "-"
        For Each c In arr2
            If InStr(1, c, b) > 0 Then
                If j = UBound(arr3) Then
                    ws3.Range(Cells(start, 1), Cells(start - 1 + j, 1)) = arr3
                    start = start + j
                    j = 0
                End If
                j = j + 1
                arr3(j, 1) = c
            End If
        Next c
    Next i
    If j > 0 Then
        ws3.Range(Cells(start, 1), Cells(start - 1 + j, 1)) = arr3
    End If
    Debug.Print "Array Time = " & Format(Timer - T1, "##.0")
    Debug.Print "Array Count = " & Format(start - 1 + j, "#,###")
End Sub

Bien que j'aie déjà proposé une réponse, je souhaite proposer ici un algorithme totalement différent afin d'améliorer les performances d'un autre ordre de grandeur.
Lorsque la "grande liste" de la feuille 1 est numérisée et que les correspondances de la feuille 2 sont recherchées, les informations relatives à une recherche réussie sont supprimées après un seul passage. Sheet1 contiendra des répétitions d'une valeur de recherche, et lors de la numérisation de sheet2, nous pouvons utiliser sa fréquence.

Le moyen de rechercher des valeurs de recherche uniques et leurs fréquences est un objet dictionnaire. Pour l'utiliser dans VBA, il faut ajouter une référence à "Microsoft Scripting" dans l'éditeur VBA.
La deuxième hypothèse est que la liste de sortie n'a pas besoin de conserver l'ordre d'entrée (car elle sera quand même triée). Le code suivant produira une liste de sortie dans sheet3 avec des valeurs de recherche dans l'ordre dans lequel elles apparaissent dans la grande liste, mais avec toutes les répétitions dans un bloc. Les instructions de timing ont été commentées car une définition de classe externe est nécessaire pour cela.

Sub zym_dict()
' http://superuser.com/questions/976906/how-to-make-nested-loop-faster-to-find-instr-in-vba
' by E/S/P 2015-09-25
' 2nd improvement: use a dictionary object to count unique search items and loop over these
' speed 1:13 vs. array version; 1:186 vs. original (cell) version

    Dim numvalues As Long, i As Long, j As Long, nextresult As Long
    Dim numcompared As Long, numresults As Long
    Dim cnt As Long
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim searchterm As String
    Dim values, arr2, results, c, v
    Dim uniq As New Scripting.Dictionary

    ' Dim mStopWatch As New clsStopWatch

    Set ws1 = Worksheets("sheet1")
    Set ws2 = Worksheets("sheet2")
    Set ws3 = Worksheets("sheet3")

    ' mStopWatch.StartWatch

    values = Intersect(ws1.Columns(1), ws1.UsedRange)
    arr2 = Intersect(ws2.Range("A:B"), ws2.UsedRange)
    numcompared = UBound(arr2, 1)

    ' collect unique values and their frequencies
    For i = 1 To UBound(values, 1)
        uniq(values(i, 1)) = uniq(values(i, 1)) + 1
    Next i

    numresults = 0
    ' 2nd index is repeat count
    For j = 1 To numcompared
        arr2(j, 2) = 0
    Next j

    For Each v In uniq
        searchterm = "-" & v & "-"
        cnt = uniq.Item(v)
        For j = 1 To numcompared
            If InStr(1, arr2(j, 1), searchterm) > 0 Then
                ' copy this value multiple times into result array
                arr2(j, 2) = arr2(j, 2) + cnt ' repeat count
                numresults = numresults + cnt
            End If
        Next j
    Next

    ' generate output list
    ReDim results(1 To numresults, 1 To 2)
    ws3.Columns(1).Clear
    nextresult = 0
    For i = 1 To numcompared
        v = arr2(i, 1)
        cnt = arr2(i, 2)  ' may be 0!
        For j = 1 To cnt
            results(nextresult + j, 1) = v
        Next j
        nextresult = nextresult + cnt
    Next i

    ' copy values to sheet
    ws3.Range(Cells(1, 1), Cells(nextresult, 2)) = results

    ' Debug.Print "runtime = " & Format(mStopWatch.StopWatch, "#0.00 ms")
    Debug.Print Format(nextresult, "#,### resulting lines")
End Sub

Par rapport au code de l'OP, l'amélioration de la vitesse est de 1: 186. Une course de 20 minutes ne prendrait alors que quelques secondes.

J'utiliserais le complément de requête de puissance pour ceci. Il a une fonction Text.Contains qui est à peu près similaire à InStr de VB. Je me suis lancé dans ce défi particulier et je l’ai fait fonctionner. Vous pouvez télécharger et utiliser mon fichier de démonstration à partir de OneDrive:

http://1drv.ms/1AzPAZp

Il s’agit du fichier: Démo Power Query - Recherche d’une liste de chaînes dans une autre liste de chaînes.xlsx.

Comme indiqué sur la feuille Lisez-moi, je n’ai pas eu à écrire beaucoup de fonctions - c’est principalement construit en cliquant sur l’interface utilisateur.

Ma conception consiste à combiner les tables Search et Target (l'équivalent de vos Sheet1 et Sheet2, je pense) pour obtenir toutes les combinaisons possibles, puis appliquez la fonction Text.Contains et filtrez le résultat.

L'un des objectifs clés de la conception est la rapidité - les données de test semi-aléatoires actuelles durent environ 1 seconde: 19 chaînes de recherche (mots actuellement uniques) 78780 chaînes cibles (lignes de War and Peace actuellement) (soit environ 1,5 million de combinaisons) 9268 Résultats allumettes.

Donc, échelle non-triviale, mais loin de vos exigences. J'espère que cela répondra à vos besoins - je suis impatient de savoir comment cela se passe.

Notez que la requête Target_Strings peut être remplacée par une requête interrogeant des données directement à partir d'une base de données ou d'un site Web. Power Query n'est pas limité à Excel en tant que source de données.