Utiliser ds une macro des datas issues de deux feuilles diff

Bonjour à tous,

Je cherche à faire une macro qui me permette de trier une plage de données en function d'un critère précis.

En effet, le but est d'adapter la population de l'étude (ici des modèles de véhicules) en fonction d'un véhicule.

Par exemple, si on choisit Clio, on met ne selectionne dans la population de véhicules que les véhicules concurrents de Clio.

La plage de données est sur une feuille nommée "Data".

La liste des véhicules concurrents en fonction du modèle sélectionné est sur une autre feuille nommée "Concur".

J'ai pour l'instant une ébauche de code, mais il est en plein chantier donc je ne pense pas qu'il serait utile de vous le partager.

Toutefois, est-ce-que l'un d'entre-vous s'il est possible et comment on gère des informations issues de deux feuilles de calcul différentes dans une meme macro.

Cordialement.

bonjour,

Une première approche :

Sub test()
Dim WsD As Worksheet, WsC  As Worksheet
Dim aD, aC '(Tableaxu dynamiques)
Dim i, j, k, x
Set WsD = Worksheets("Data")
Set WsC = Worksheets("Concur")
aD = WsD.[A1].CurrentRegion.Value
aC = WsC.[A1].CurrentRegion.Value
'Comparaison de range
If WsD.Range("A1") <> WsC.Range("A1") Then
End If

'Comparaison des tableaux
For i = 1 To UBound(aD, 1) 'UBound(aD, 1) = Nbre de ligne de WsD
   For j = 1 To UBound(aD, 2) 'UBound(aD, 2) = Nbre de Colonne de WsD
      For k = 1 To UBound(aC, 1) 'UBound(aC, 1) = Nbre de ligne de WsC
         For x = 1 To UBound(aC, 2) 'UBound(aC, 2) = Nbre de Colonne de WsC
            If WsD.Cells(i, j) = WsC.Cells(k, x) Then
               MsgBox i & " - " & j & " / " & k & " - " & x
            End If
         Next
      Next
   Next
Next
End Sub

A+

Bonjour Galopin,

Alors tout d'abord, merci beaucoup, ton explication est vraiment top. Je ne l'ai pas encore testée mais j'ai bien compris son fonctionnement.

J'essaie de faire fonctionner cette macro avec une logique un peu différente. Voilà mon code un peu amélioré (mais toujours bugué):

Sub Selection()

Dim Model As Object
Dim Concur As Worksheet
Dim Etude As Worksheet
Dim Title As Range
Dim Liste As Range

Set Etude = Sheets("Etude")
Set Concur = Sheets("Concur")

Etude.Activate
Set Model = Cells(1, 1)

Concur.Activate

Set Title = Range("B2", Range("B2").End(xlToRight))

For Each Cell In Title
    If ActiveCell.Text = Model.Text Then
    Set Liste = Range("Activecell", Range("Activecell").End(xlDown))
    End If
Next
'
'If Model.Text = "JFA" Then
'Concur = Range("B3,B17")
'    ElseIf Model.Text = "BFB" Then
'    Concur = Range("C3,C17")
'    ElseIf Model.Text = "LFF" Then
'    Concur = Range("D3,D17")
'    ElseIf Model.Text = "LFD" Then
'    Concur = Range("E3,E17")
'    ElseIf Model.Text = "LFH" Then
'    Concur = Range("F3,F17")
'    ElseIf Model.Text = "HFE" Then
'    Concur = Range("G3,G17")
'    ElseIf Model.Text = "JFC" Then
'    Concur = Range("H3,H17")
'    ElseIf Model.Text = "JFG" Then
'    Concur = Range("I3,I17")
'    ElseIf Model.Text = "XFD" Then Concur = Range("J3,J17")
'End If

MsgBox (Concur)

End Sub

La partie commentée est la première façon avec laquelle j'envisageais de,travailler (qui ne marche pas non plus).

Est-ce-que cela t'aide à comprendre ma demarche?

Celà n'est que la première partie de l'action, puisqu'ensuite, il faura que je supprime toutes les lignes dans la feuille Etude (Data renommée) qui ne contiennent pas les nom d'un vh concurrent.

Tant que tu vas travailler avec des Select, Activate et ActiveCell, tu vas travailler "dans les courants d'air" (sans jamais avoir une idée bien claire de ce que tu manipules...)

Tu remarqueras que chacune de mes lignes comporte pour chaque cellule, ou variable la référence à la feuille D ou C ce qui évite d'activer quoi que ce soit.. et définit avec précision chaque cellule. Si tu instancies des variables c'est pour t'en servir, pas pour exposer sur une étagère...

Utilise des noms de variables courts et évocateur

aD = WsD... "Data" : on voit tout de suite la relation

aC = WsC... "Conc" : idem

Tes Title, Liste ne me parlent pas... Il faut se creuser la cervelle pour savoir à quoi ils se rapportent !

Dans l'expression :

For Each Cell In Title
    If ActiveCell...

ActiveCell ne change jamais... Même si ton For each balaye 1 000 000 de cellules, ActiveCell ne changera jamais...

Toute une éducation à refaire !

Ensuite quand tu as une collection de if comme ça il vaut mieux écrire :

Sub test()
Dim S$
'...
Select Case Model
Case "JFA": S = "B3,B17"
Case "BFB": S = "C3,C17"
Case "LFF": S = "D3,D17"
Case "LFD": S = "E3,E17"
Case "LFH": S = "F3,F17"
Case "HFE": S = "G3,G17"
Case "JFC": S = "H3,H17"
Case "JFG": S = "I3,I17"
Case "XFD": S = "J3,J17"
End Select
Concur = Range(S)
End Sub

... mais un MsgBox (Concur) n'a pas de sens dans ce contexte !

Difficile de t'en dire plus. C'est quand même pas trop clair ton histoire.

A+

Bonjour galopin,

J'ai bien pris note de tes remarques, merci beaucoup!

Comme tu dis, il y a toute une education à (re)faire! Ma connaissance en VBA est crépusculaire pour le moment, mais j'essaie de progresser.

Ainsi j'ai quelques questions par rapport à la declaration des variables. Tu écris:

Dim aD, aC '(Tableaxu dynamiques)
Dim i, j, k, x

Comment se fait-il que tu n'ai pas à ajouter des "As Integer" par exemple?

J'aurais également besoin de savoir pourquoi tu utilise la methode CurrentRegion dans les lignes:

aD = WsD.[A1].CurrentRegion.Value
aC = WsC.[A1].CurrentRegion.Value

J'arrive à comprendre ce que tu fais, mais j'aimerais avoir une expliquation de la logique "VBA" qui va derrière pour bien intégrer la façon de coder sur Excel.

Merci à toi en tout cas, tes explications sont trés bienvenues!

Cordialement.

C'est vrai que je n'ai pas "typé" mes déclarations.

J'ai juste fait les déclarations "à minima" au cas ou tu aurais une Option Explicit qui trainerait par là... pour éviter un msg d'erreur.

Pour une courte explication comme ça c'est bien suffisant...

Les tableaux sont parfois difficile à typer... En particulier les tableaux dynamiques.

Quelques "croquants" (dont je fais partie) omettent délibérément de les typer... Ce qui n'est pas que de la négligence.

Le mini exemple ci-joint illustre un peu CurrentRegion associé au tableau dynamique (Lancer la macro contenue dans Feuil1)

C'est pas forcément ce par quoi on commence quand on veut s'initier aux Array, mais ça illustre bien leur puissance...

A+

Bonjour galopin,

Je viens te voir au sujet d'un autre projet.

Je cherche à trier un plage de données en supprimant des lignes de data en function du nombre de à qu'elles contiennent.

Pour ce faire, j'ai créé une macro qui balaye la plage de données et qui colore chaque ligne dont le nombre de 0 est supérieur à la tolerance exprimée par l'utilisateur.

Il y a ensuite un second balayage qui permet de supprimer chaque ligne qui contient une cellule colorée. J'ai procédé en deux balayages pour être sûr de pouvoir traiter chaque ligne, sans en manquer une à cause de la remontée de ligne causée par la suppression de la ligne précédente.

Le problème qui se pose, c'est que la macro ne supprime pas correctement et je n'arrive pas à comprendre pourquoi. Elle laisse des lignes colorées et en supprime d'autre. Je suis donc obligé de recommencer l'execution plusieurs fois pour que le résultat soit correct.

Sub Tri()

Dim count As Integer
Dim Rw As Range
Dim i, j, x

x = InputBox("Indiquez le nombre de valeurs nulles à partir desquelles la série est ingorée")

For i = 11 To 173
    count = 0
    For j = 10 To 17
        If Cells(i, j).Value = 0 Then
        count = count + 1
        End If
    Next
        If count >= x Then
        Rows(Cells(i, j).Row).Interior.Color = RGB(55, 200, 255)
        End If
Next

For Each Cell In Range("A1:A173")
    If Cells.Interior.Color = RGB(55, 200, 255) Then
        EntireRow.Delete
    End If
Next
'For i = 11 To 173
'    If Rows(Cells(i, 1).Row).Interior.Color = RGB(55, 200, 255) Then
'    Rows(Cells(i, 1).Row).Delete Shift:=xlUp
'    End If
'Next

MsgBox ("Done")

Est-ce-que tu pourrais m'aider là dessus?

Merci d'avance.

Bonjour,

Quand on supprime c'est plus simple de commencer par la fin.

J'ai remplacé count par cpt car count est une propriété : Bien que ce ne soit pas un mot réservé, il n'est jamais bon de mélanger le vocabulaire VisualBasic avec les variables...

Sub Tri()
Dim cpt As Integer, cell
Dim Rw As Range
Dim i, j, x
x = Val(InputBox("Indiquez le nombre de valeurs nulles à partir desquelles la série est ingorée"))
Application.ScreenUpdating = False

For i = 173 To 11 Step -1
cpt = 0
For j = 10 To 17
   If Cells(i, j).Value = 0 Then
   cpt = cpt + 1
   End If
Next
   If cpt >= x Then Rows(i).Delete
Next

MsgBox ("Done")
End Sub

A+

Merci galopin, ça marche parfaitement

Lors d'une suppression, on préfère justement remonter les datas pour éviter le soucis de remonté de ligne lors de la suppression?

Peux-tu m'expliquer le role de l'instruction "Step -1" stp?

On part de la ligne 173 pour arriver à la ligne 11 "par pas de" -1 :

On pourrait le faire "par pas de" -2, 3... 10 (une ligne sur -2, 3...10 !

Mais de la même manière dans une autre situation (pour faire des rayures par exemple)

on pourrait

parcourir les lignes de 2 à 10 par exemple "par pas de" 2, 3...

Sub test()
Dim i%
For i = 2 To 10 Step 2
Rows(i).Interior.ColorIndex = 3
Next
End Sub

A+

(re) Bonjour Galopin01,

Je déterre ce post de longue date car je me retrouve à nouveau dans une situation bloquante similaire à celle de la dernière fois avec ma liste.

Je cherche ici à nettoyer une liste de toutes les lignes en doubloon.

Chaque ligne est constitué de 4 cellules renseignées avec du texte. Pour qu'il y ait doublon, il faut que les 4 cellules de la ligne inférieure soient identiques aux 4 cellules de la case supérieure.

S'il y a doublon, on supprime une des deux lignes (ici la ligne inférieure).

Malheureusement, le code que j'ai écrit est d'une anormalement long à s'exécuter, et de deux, il crashe toujours après quelques lignes parcourues avec comme message d'erreur: "Erreur 1004, erreur définie par l'application ou l'objet"...

J'ai essayé pas mal de modifications mais je n'ai plus aucune idée pour le moment, alors je m'en remets à toi

Merci d'avance

Sub vehicle_comparison()

Dim i As Long
Dim j As Long
Dim lignfin As Long
Dim k As Integer

'Récupération de la liste des véhicules
Sheets.Add After:=Sheets("Analyse")
ActiveSheet.name = "..."

Application.ScreenUpdating = False

Workbooks("DATA Hybrides JATO").Sheets("...").Columns("A:B").Value = Workbooks("DATA Hybrides JATO").Sheets("Classeur JATO - Feuille 1").Columns("H:I").EntireColumn.Value
Workbooks("DATA Hybrides JATO").Sheets("...").Columns("C:C").Value = Workbooks("DATA Hybrides JATO").Sheets("Classeur JATO - Feuille 1").Columns("K:K").EntireColumn.Value
Workbooks("DATA Hybrides JATO").Sheets("...").Columns("D:D").Value = Workbooks("DATA Hybrides JATO").Sheets("Classeur JATO - Feuille 1").Columns("M:M").EntireColumn.Value

Cells(1, 1).End(xlDown).Select
lignfin = ActiveCell.Row

For i = lignfin To 1 Step -1
    k = 0
    For j = 1 To 4
        If Cells(i, j).Value = Cells(i - 1, j).Value Then
            k = k + 1
        End If
    Next
    If k = 4 Then
        Rows(i).Delete
    End If
Next

Application.ScreenUpdating = True

'Workbooks("DATA Hybrides JATO").Sheets("Analyse").Activate

End Sub