Macro VBA Excel compliquée avec boucle

Question

J'ai besoin d'aide avec une boucle de macro VBA raisonnablement compliquée pour un jeu de données que j'ai reçu. L'ensemble de données existe sous la forme d'une longue colonne et de milliers d'entrées différentes.

J'ai essayé d'enregistrer des macros mais je ne sais pas comment l'aborder. Toute aide serait grandement appréciée. Dans ses termes les plus simples, j'ai besoin de localiser un terme (c.-à-d. "CECI EST UN TEST"), copier cette cellule dans une nouvelle feuille de travail, aller 72 cellules et copier tout ce qui est dans cette cellule dans la nouvelle feuille de calcul.

Logic pour la macro VBA boucle ...

1. parcourons toutes les feuilles pour les mots "CECI EST UN TEST"
2. Copier cette cellule dans une nouvelle feuille de calcul (par exemple. A1)
3. 72 Go cellules jusqu'à
4. Copiez cette cellule dans la nouvelle feuille de calcul (par exemple. B1)

Il faut faire une boucle à travers la logique ci-dessus à travers toutes les feuilles ouvertes, déverser les résultats dans une nouvelle feuille de travail.

Encore une fois, merci pour toute aide que je reçois.

Answer 1

Voici un début. Vos notes suggèrent que les mots n'apparaîtront qu'une seule fois dans chaque feuille et qu'il y aura une pile de 72 lignes en arrière. J'ai inclus des notes sur la vérification de ces deux éléments, mais seulement schématiquement.

Dim c As Range 
Dim s As Worksheet 
Dim sr As Worksheet ''For results 
Dim r1 As Long ''Row counter 
Dim i As Long ''Incidence counter 
Dim firstAddress As Variant 

''New worksheet for results 
Set sr = ActiveWorkbook.Worksheets.Add 
r1 = 1 

''It might be better to use a named workbook 
For Each s In ActiveWorkbook.Worksheets 
    ''Don't check results sheet 
    If s.Name <> sr.Name Then 
    ''From: http://msdn.microsoft.com/en-us/library/aa195730(v=office.11).aspx 
     With s.UsedRange 
      Set c = .Find("THIS IS A TEST", LookIn:=xlValues, LookAt:=xlWhole) 
      i = 0 
      If Not c Is Nothing Then 
       firstAddress = c.Address 
       sr.Cells(r1, 1) = c.Value 

       If c.Row - 72 > 0 Then 
        sr.Cells(r1, 2) = s.Cells(c.Row - 72, c.Column) 
       Else 
        sr.Cells(r1, 2) = "Error" 
       End If 

       i = 1 
       r1 = r1 + 1 

       Do 
        i = i + 1 
        Set c = .FindNext(c) 
       Loop While Not c Is Nothing And c.Address <> firstAddress 
      End If 
     End With 
    End If 
    Debug.Print s.Name & " found: " & i 
Next