Rapatrier des données

**ANTMA** · 15/12/2007, 17h04

Bonjour,

Je voudrais faire une macro qui récupère des données d'une feuille nommé data prototype et les rapatries dans une feuille data global si et seulement si les dates et les ref sont les mm

j'ai mis un fichier en exemple merci de votre aide

**ANTMA** · 15/12/2007, 17h06

il faut juste rapatrié les valeurs de la feuille data prototype si et seulement si les dates ref et cdl sont les mêmes.

Les valeurs doivent être rappatrié dans la colonne valeur de la feuille data global

**LeForestier** · 15/12/2007, 17h09

Pourquoi tu met un nouveau poste sur un même sujet ? alors qu'ont est occupés a essayé de t'aider.
A+

**ANTMA** · 15/12/2007, 17h20

Non il s'agit d'un autre problémes que j'ai c'est de rapatrié en fonction des date ref et CDL mes valeurs si elles sont les mêmes sur les deux feuilles et non de sommer les valeurs des classes pour une mm ref et date

**LeForestier** · 15/12/2007, 17h26

Autant pour moi,
Mais plutôt que de mettre chaques fois ton fichier, tu pourrais pas mettre le code en question dans le poste.
A+
Edit : Il serrait aussi préférable de résoudre le 1er problème avant de passer au suivant non ?

**ANTMA** · 15/12/2007, 17h33

je viens de le tester (le premier prob) avec votre code et cela me semble ok c'est pour cela que je me suis permis de poster cenouveau probleme a sousmettre a vos cerveaux de génie

**ouskel'n'or** · 15/12/2007, 19h48

Si ce problème est résolu, alors un petit clic sur le grand

ci-dessous

**ANTMA** · 16/12/2007, 15h30

Bonjour,

Ce probleme la n'est pas résolu il s'agit de rapatrier des données d'une feuille si et seulement si les dates et les ref sont les mêmes

**ouskel'n'or** · 16/12/2007, 16h00

Tu peux créer un filtre multi-critères, un sur la date et un sur la référence. Regarde ici http://www.developpez.net/forums/sho...d.php?t=450878
Si ce n'est pas ce que tu veux, donne plus de précisions

A+

**ANTMA** · 16/12/2007, 17h41

Non en fait j'ai une feuille Data Global ou il y a des dates et des ref articles et une colonne nommé cdl une colonne classe et à coté de cela j'ai une autre feuille nommé data prototype qui se décompose en une colonne Date une colonne ref une colonne cdl et des classe et des valeurs et je souhaite rapatrié les valeurs de ma feuil data prototype si les dates et ref et les cDL sont égaux aux dates et ref et cdl de ma feuil Data Global .

PS : j'ai mis un fichier exemple de ce que je cherche à faire en début de post

par avance merci du coup de main

**ouskel'n'or** · 16/12/2007, 19h03

Ok, j'ai ouvert ton fichier.

Envoyé par toi

et je souhaite rapatrié les valeurs de ma feuil data prototype si les dates et ref et les cDL sont égaux aux dates et ref et cdl de ma feuil Data Global .

Rapatrier quoi : "Les valeurs de ta feuil data prototype"
Rapatrier où ???
Selon les critères pris où ???
A+

**ANTMA** · 16/12/2007, 19h11

oui rapatrier les valeurs de la feuil data prototype vers la colonne 12 de la feuil data global si et seulement si les dates les ref et les cdl et la classe sont les même.

EX feuill data global

24/11/2007 XZ0006 AME J

j'ai cette mme date cette mm ref et ce mm cdl et la mm classe dans la feuill data prototype

alors je rapatrie juste la valeur ici :

52.275964727

**ouskel'n'or** · 17/12/2007, 00h39

Ok.
Je t'envoie un début de code qu'il faudra compléter.
Si une occurence est rencontrée plusieurs fois dans la page Data Global, seule la première occurence rencontrée est prise en compte.
La fonction Adresse ne renvoie qu'un N° de ligne. Il reste donc à créer un tableau des No de lignes présentant une correspondance dans l'autre feuille afin de l'utiliser dans la macro Test()
Il est facile d'y remédier mais là, je passe à autre chose

Fais dérouler la macro Test pas par pas (F8) pour en suivre le déroulement et essayer d'en comprendre le code.

La méthode ci-après utilise les filtres.
Une autre méthode consisterait en une boucle sur les données de la feuille "Data prototype" et une sur la feuille "Data Global". Impose, pour chaque ligne de la feuille "Data prototype", de vérifier sa présence dans toutes les lignes de la feuille "Data Global".
La méthode Find pourrait être intéressante.
Une boucle sur la colonne 1 des lignes de la feuille "Data prototype", un boucle de recherche sur la colonne 1 de la feuille "Data Global". Pour chaque date identique, vérification des colonnes 2, 5 et 6.
Comme toutes les dates sont identiques dans l'exemple donné, toutes les lignes seraient examinées. Dans ce cas là, la méthode serait encore plus longue que ligne par ligne.
Je n'ai pas pensé à une autre méthode pouvant consister à comparer la ligne dans son ensemble, de la colonne 1 à 6.
Je vérifierai si c'est possible mais fais également des recherches dans ce sens de ton côté.
N'est valable que si tes colonnes 3 et 4 n'ont pas de données différentes pour les deux lignes comparées ayant une correspondance pour les 4 autres critères.
Là, j'ai besoin de cette précision.
Bon courage pour compléter par la création d'un tableau de lignes dans la fonction, si j'ai un moment demain, je regarderai.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Explicit
Sub Test()
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim Cell As Range, adres As Integer
Dim Plage As Range
    Set FL1 = Worksheets("Data Global")
    Set FL2 = Worksheets("Data prototype")
    FL1.Columns("A:A").NumberFormat = "0"
    FL2.Columns("A:A").NumberFormat = "0"
    FL1.Activate
    Set Plage = FL1.Range(Cells(14, 1), Cells(21, 1))
    For Each Cell In Plage
        adres = Adresse(FL1, Cell, Cell.Offset(0, 1), Cell.Offset(0, 4), Cell.Offset(0, 5))
        If Not adres = Empty And Not adres = 0 Then
            '*** A modifier en bouclant sur le tableau des N° de lignes ***
            Cell.Offset(0, 11) = FL2.Cells(adres, 7)
            '********************************************************
        End If
    Next
    Set FL1 = Nothing
    Set Plage = Nothing
End Sub


Function Adresse(FL1 As Worksheet, ParamArray ctrs()) As Integer
Dim DerCol As String, NoCol As Integer, derlig
Dim Colonnes As Variant, Plage As Range, NoLig As Long
Dim FL2 As Worksheet
    Set FL2 = Worksheets("Data prototype")
    'MsgBox ctrs(0) & "  " & ctrs(1) & "  " & ctrs(2) & "  " & ctrs(3) & "  "
    Colonnes = Array(1, 2, 5, 6)

    'Suppression d'un filtre existant éventuel
    If FL2.FilterMode = True Then FL2.AutoFilterMode = False
    DoEvents
 
    'Pose du filtre sur toutes les colonnes de la plage de données
    FL2.Columns("A:" & ctrs(UBound(ctrs))).AutoFilter
    DoEvents
    'Filtrage des n colonnes
    For NoCol = 0 To UBound(ctrs)
        Set Plage = FL2.Columns(Colonnes(NoCol))
            Plage.CurrentRegion.AutoFilter _
                Colonnes(NoCol), ctrs(NoCol)
    Next NoCol
    
    derlig = FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    
    '************* A MODIFIER POUR RENVOYER UN TABLEAU DE No DE LIGNES ************
    For NoLig = 2 To derlig
        'ok = Not FL2.Rows(NoLig).EntireRow.Hidden
        If Not FL2.Rows(NoLig).EntireRow.Hidden Then
            Adresse = NoLig
            Exit Function
        End If
    Next
    '******************************************************************************
    
End Function

Bonne nuit
A+

**ANTMA** · 17/12/2007, 12h34

C super sa marche mais je comprends pas pourquoi la macro s'arrete ligne 21

**ANTMA** · 17/12/2007, 13h04

Bonjour,

le code marchait dans le fichier test que j'ai envoyé mais quand je l'ai incorporé dans mon vrai fichier ca ne marche pas. J'ai un débogage sur cette ligne "Erreur de type 13, incompatibilité de type"

Sur cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  FL2.Columns("A:" & ctrs(UBound(ctrs))).AutoFilter

Voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
  Option Explicit
Sub test()
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim Cell As Range, adres As Integer
Dim Plage As Range
    Set FL1 = Worksheets("Data Global")
    Set FL2 = Worksheets("Data prototype")
    FL1.Columns("A:A").NumberFormat = "0"
    FL2.Columns("A:A").NumberFormat = "0"
    FL1.Activate
    Set Plage = FL1.Range(Cells(14, 1), Cells(19043, 1))
    For Each Cell In Plage
        adres = Adresse(FL1, Cell, Cell.Offset(0, 1), Cell.Offset(0, 4), Cell.Offset(0, 5))
        If Not adres = Empty And Not adres = 0 Then
            '*** A modifier en bouclant sur le tableau des N° de lignes ***
            Cell.Offset(0, 11) = FL2.Cells(adres, 7)
            '********************************************************
        End If
    Next
    Set FL1 = Nothing
    Set Plage = Nothing
End Sub
 
 
Function Adresse(FL1 As Worksheet, ParamArray ctrs()) As Integer
Dim DerCol As String, NoCol As Integer, derlig
Dim Colonnes As Variant, Plage As Range, NoLig As Long
Dim FL2 As Worksheet
    Set FL2 = Worksheets("Data prototype")
    'MsgBox ctrs(0) & "  " & ctrs(1) & "  " & ctrs(2) & "  " & ctrs(3) & "  "
    Colonnes = Array(1, 2, 5, 6)
 
    'Suppression d'un filtre existant éventuel
    If FL2.FilterMode = True Then FL2.AutoFilterMode = False
    DoEvents
 
    'Pose du filtre sur toutes les colonnes de la plage de données
    FL2.Columns("A:" & ctrs(UBound(ctrs))).AutoFilter
    DoEvents
    'Filtrage des n colonnes
    For NoCol = 0 To UBound(ctrs)
        Set Plage = FL2.Columns(Colonnes(NoCol))
            Plage.CurrentRegion.AutoFilter _
                Colonnes(NoCol), ctrs(NoCol)
    Next NoCol
 
    derlig = FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
 
    '************* A MODIFIER POUR RENVOYER UN TABLEAU DE No DE LIGNES ************
    For NoLig = 2 To derlig
        'ok = Not FL2.Rows(NoLig).EntireRow.Hidden
        If Not FL2.Rows(NoLig).EntireRow.Hidden Then
            Adresse = NoLig
            Exit Function
        End If
    Next
    '******************************************************************************
 
End Function
 
 
Sub Virgule()
Dim i As Integer
Dim e As Integer
Dim D As Double
Dim Txt As String
    Sheets("Data prototype").Select
    For i = 2 To Range("I1").SpecialCells(xlCellTypeLastCell).Row
        Txt = Cells(i, 7)
        e = InStr(1, Txt, ".")
        If e > 0 Then
            Mid(Txt, e, 1) = ","
            D = Format(Txt, "###.#############")
            Cells(i, 7).Value = D
        End If
    Next i
End Sub

**ouskel'n'or** · 17/12/2007, 14h48

Oui, j'ai dû modifier quelque chose et ne pas l'avoir entièrement reposté sur le code. Je dis ça parce que j'ai mis est idiot.
Remplace par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    FL2.Cells.AutoFilter

C'est brutal mais ça fonctionne.
Pour limiter aux seules colonnes concernées ce serait en l'état de tes feuilles :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FL2.Columns("A:G").autofilter

mais ça fige les colonnes et je préfère toujours obtenir leur nombre en dynamique.
Tu testes

A+

**ANTMA** · 17/12/2007, 15h06

ca marche du feu de dieu mais ça s'arrete à la ligne 21 ????

**ouskel'n'or** · 17/12/2007, 18h23

J'ai corrigé le code pour le N° de colonne et le remplacement du point par une virgule

Dans la Function Adresse, corrige les lignes en rouge

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    'Suppression d'un filtre existant éventuel
    If FL2.FilterMode = True Then FL2.AutoFilterMode = False
    DoEvents
    'Dernière colonne de la plage de données
    DerCol = Split(FL2.Cells(1, Rows(1).Cells.Count).End(xlToLeft).Address, "$")(1)
 
    'Pose du filtre sur toutes les colonnes de la plage de données
    FL2.Columns("A:" & DerCol).AutoFilter    DoEvents
    'Filtrage des n colonnes
    For NoCol = 0 To UBound(ctrs)
        Set Plage = FL2.Columns(Colonnes(NoCol))
            Plage.CurrentRegion.AutoFilter _
                Colonnes(NoCol), ctrs(NoCol)
    Next NoCol

et ajoute la déclaration de DerCol si elle n'y est pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim DerCol As String

Dans la macro Lecture, corrige la ligne en rouge

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
        If Not adres = Empty And Not adres = 0 Then
            Cell.Offset(0, 11) = Replace(FL2.Cells(adres, 7), ".", ",")
        End If

Maintenant, on va pouvoir traiter le tableau des lignes ayant les mêmes critères.
Ce que je ne comprends pas c'est que tu peux avoir des lignes identiques pour ce qui concerne les critères mais différentes pour ce qui est des valeurs. Ex

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

39410	XE0022			APC	J

que tu as deux fois
Tu expliques ?
A+

Edit
La ligne à corriger dans Lecture est destinée à remplacer ta Sub Virgule().
Si tu as une version > 97, tu as la fonction Replace qui permet de remplacer ce que tu ne veux pas par ce que tu veux

Edit (re)
Le N° de ligne est donné par ça

Set Plage = FL1.Range(Cells(14, 1), Cells(21, 1))

Il faut remplacer 21 par DerLig ici aussi, mais ce n'est pas la même que dans la fonction... mais c'est la même formule, mais ce n'est pas la même feuille... bref

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    Dim DerLig as long
    derlig = FL1.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    Set Plage = FL1.Range(Cells(14, 1), Cells(derlig, 1))

Ça, c'est pour que tu puisses lire toute ta plage de la feuille "Data Global"

C'est ok, ce coup-ci ?

PS - Je sais que c'est long mais lis bien tout

Je viens de faire le lien avec ton post sur les doublons. Tu as réglé ça ? Comment fais-tu quand tu as des valeurs différentes dans des doublons ?
Je m'inquiète ! Je sens que je vais encore mal dormir ce soir...

**ANTMA** · 18/12/2007, 11h21

Bonjour,

Oui sa marche mais j'ai une question concernant le code peut ON supprimer la colonne CDL de comparaison C'EST à DIRE JUSTE COMPARER ET RAPATRIER LES DONNeES SI LA DATE la ref ET LA CLASSE SonT éGALE

Pour mon problème de doublons je cherche à faire une macro qui supprime les lignes avec classes et valeur en double, lorsque les classes sont les mm et les valeurs différente il faut prendre la valeur la plus élevé.

Je sais je suis horrible, désolé d'envahir votre forum comme ca mais j'ai vraiment besoin d'aide.

Me suis mm achete un bouquin sur le VBA à 45€

**ANTMA** · 19/12/2007, 09h26

quel ligne je dois modifier pour changer la colonne d'arrivé des mes donnés ?

Rapatrier des données

Macros et VBA Excel

Discussions similaires

Partager

Partager