VBA- Extraction de données

[Zhanties]

Bonjour,

je m'en remet de nouveau à vous (remercie à la communauté pour les autres fois) pour avancer sur un point mort.
Je dispose actuellement de deux tableaux, l'un étant imbriqué dans l'autre. Ma première étape a été de coloriser les données du tableau 2 (appelé Stoxx Europe 600 dans le fichier) dans le tableau 1 (appelé 1 mois av date d'annonce) dans Feuil1.

Dans ce tableau 1, vous pouvez voir sur la colonne J un "ranking". Je voudrai extraire toutes les valeurs bleus (donc les données du deuxième tableau présent dans le premier) au delà de 600 du classement (ranking) en prenant leur nom, ticker et le rang (colonne B, C et J) puis les mettre dans la feuille "Tableau" dans la partie "Sortie" en H, I et J.

Puis, extraire les valeurs noirs du tableau 1 qui sont en dessous de 600 dans la colonne ranking et effectuer le même raisonnement en les mettant dans la feuille "Tableau" dans la partie "Entrée".

Voici ce que j'ai pour l'instant :

Option Explicit

Sub StoxxTMI()


Dim PlageStoxx600 As Range
Dim PlageStoxxTMI As Range
Dim CellStoxx600 As Range
Dim CellStoxxTMI As Range




    With Worksheets("Feuil1")
       
        Set PlageStoxx600 = .Range(.Cells(5, 14), .Cells(.Rows.Count, 14).End(xlUp))
        Set PlageStoxxTMI = .Range(.Cells(5, 2), .Cells(.Rows.Count, 2).End(xlUp))
      
    End With
   
     With Worksheets("tableau")
      .Range("b3:d" & Rows.Count).Clear
      .Range("h3:j" & Rows.Count).Clear
     End With
   
   

    For Each CellStoxxTMI In PlageStoxxTMI
        Set CellStoxx600 = PlageStoxx600.Find(CellStoxxTMI, , xlValues, xlWhole)
       
        If Not CellStoxx600 Is Nothing Then
          
            CellStoxxTMI.Resize(, 9).Font.ColorIndex = 5
           
                
             
        Else
           
        End If
    Next CellStoxxTMI
End Sub


Sub shortcut()

Application.OnKey "^q", "StoxxTMI"

 

[Bebere]

bonjour
bienvenue
Zanthies pour le résultat je pense qu'il y a problème avec les couleurs(excel2010)

 

[Zhanties]

Bonjour Bebere,

j'ai passé la matinée à essayer quelques chose que j'allais partager avant de voir ta réponse mais ton code et bien plus propre et efficace que celui que j'avais fais (et il marche).
Les couleurs en effet ne s'affichent pas si je remet tout en noir mais c'est à la limite superflu.
Néanmoins pourrais-tu m'éclairer, je n'ai pas compris à quoi servait ces 2 lignes :

.Range("A1") = .Range("B10").Font.ColorIndex
.Range("A2") = .Range("B5").Font.ColorIndex

qui dans l'excel renvoit à 1 et 5.

A par ça, j'ai modifié quelques petits trucs, comme les noms confondus de StoxxTMI et 600, je les ai juste inversé donc ça pas de problème. Les résultats du tableau "sortie" sont nickel mais ceux d'entrée doivent être les valeurs du tableau TMI non présente dans le tableau Stoxx600 et non pas les valeurs du Stoxx600 présent dans le TMI. Du coup j'ai voulu modifier mais cela me donne un résultat très étrange et totalement incorrect.
J'ai juste remplacé :

If CellStoxxTMI.Offset(0, -8).Value = CellStoxx600.Value Then


par

If CellStoxxTMI.Offset(0, -8).Value <> CellStoxx600.Value Then

 

[Bebere]

zhanties version corrigée

 

[Zhanties]

Il n'y aurait pas une erreur avec le "A" de cette ligne?

Set rng = .Range(.Cells(5, "A"), .Cells(Li - 1, "A"))

car A ne correspond à rien dans le tableau.
Les lignes se mélangent car j'ai à la fois des valeurs bonnes (colorisé en noir) comme "Remy Cointreau SA" ligne 618 de Feuil1, mais aussi des valeurs fausses comme Novartis AG (colorisé en bleu) comme Novartis AG ligne 122.

Je ne comprend pas aussi :

rng.Cells(CellStoxx600.Row, 1) = "x": Exit For

Que représente le "x"?

Je suis désolé de ne pas arriver à suivre vu que tu essaies de m'aider. Peux-tu m'expliquer ces deux lignes ci-dessus?
Bien que je sens qu'on soit proche ^^
Je continue toujours de mon côté bien entendu.

 

[Staple1600]

Bonsoir le fil, le forum

@Zhanties
Pour t'aider à comprendre

Sub PourComprendre()
'Trois syntaxes pou un même résultat
MsgBox "=>Range(""A1"").Address=" & Range("A1").Address(0, 0)
MsgBox "=>Cells(1, 1).Address=" & Cells(1, 1).Address(0, 0)
MsgBox "=>Cells(1, ""A"").Address=" & Cells(1, "A").Address(0, 0)
End Sub

Donc le A correspond simplement à indiquer la colonne A (ou colonne 1)

 

[Bebere]

bonjour Zhanties,Staple
la colonne A sert à pointer les correspondances de la comparaison
pour avoir la liste des absents(si rng.cells(ligne x,"A") est vide )
la colonne est effacée à la fin du code
pour ce que tu signales(valeurs bonnes ou fausses) plus haut tu dis que
je cite'à la limite c'est superflu'
pour les couleurs j'ai enregistré une macro qui ne me donne pas colorindex mais un thème
quelle est la valeur des colorindex chez toi(jai mis 2 et 5 black et blue d'après le tableau dans l'aide)
par code cela donne 1 et 5

 

[Zhanties]

Bonjour,
j'ai trouvé une solution avec encore quelques petits détails à fignoler. J'ai continué sur le premier fichier que Bebere a effectué (car je le comprenais plus facilement). Les données mises dans le tableau "entrée" sont donc maintenant correct mais avec énormément de doublons. Donc on peut les supprimer manuellement avec l'outil excel "supprimer les doublons" mais ce n'est pas très pratique.
ça ne devrait pas être très compliqué à mettre en place mais j'ai de nouveau raté, j'ai laissé cette partie entre guillement dans le code

With Worksheets("Feuil1")


        Set PlageStoxxTMI = .Range(.Cells(5, "J"), .Cells(.Rows.Count, "J").End(xlUp))
        Set PlageStoxx600 = .Range(.Cells(5, "N"), .Cells(.Rows.Count, "N").End(xlUp))


    End With

    With Worksheets("tableau")
        .Range("b3:d" & Rows.Count).Clear
        .Range("h3:j" & Rows.Count).Clear
    End With
    L = 2: L1 = 2
    For Each CellStoxxTMI In PlageStoxxTMI
        If CellStoxxTMI.Value <= 600 Then
            If CellStoxxTMI > 0 And CellStoxxTMI.Font.ColorIndex = 1 Then
                For Each CellStoxx600 In PlageStoxx600
                    If CellStoxxTMI.Offset(0, -8).Value <> CellStoxx600.Value Then
                        L = L + 1
                        Feuil5.Range("B" & L).Value = CellStoxxTMI.Offset(0, -8).Value
                        Feuil5.Range("C" & L).Value = CellStoxxTMI.Offset(0, -7).Value
                        Feuil5.Range("D" & L).Value = CellStoxxTMI
                    End If
                Next
            End If
        End If
    Next
 
    ' With Worksheets("Tableau")
     'Set NewTableau = .Range(.Cells(3, "B:D"), .Cells(.Rows.Count, "B:D").End(xlUp))
  
     'End With
     'NewTableau = Selection.RemoveDuplicates
 
    For Each CellStoxxTMI In PlageStoxxTMI
            If CellStoxxTMI.Value > 600 Then
                If CellStoxxTMI.Font.ColorIndex = 5 Then

                    For Each CellStoxx600 In PlageStoxx600

                        If CellStoxxTMI.Offset(0, -8).Value = CellStoxx600.Value Then
                            L1 = L1 + 1
                            Feuil5.Range("H" & L1).Value = CellStoxxTMI.Offset(0, -8).Value
                            Feuil5.Range("I" & L1).Value = CellStoxxTMI.Offset(0, -7).Value
                            Feuil5.Range("J" & L1).Value = CellStoxxTMI
                        End If

                    Next CellStoxx600
                End If
            End If

        Next
        Feuil5.Columns("B:D").AutoFit
        Feuil5.Columns("H:J").AutoFit
     
     
        MsgBox "Durée : " & Format(Timer - t0, "0.00\ .sec.")
     
    End Sub

 

[Zhanties]

Je rajoute la pièce jointe

 

[Bebere]

Zanthies il faut avancer
ajout d'un dictionnaire et d'un tri trientrée et tri sortie module2
pour comprendre,exécute le code en pas à pas(touche fonction F8),fenêtre variables locales active