Macro de recopiage de données sur lignes spécifiques

**Identifiant75** · 21/05/2015, 15h32

Bonjour voici la macro:

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
Sub copie2()
Dim Origine As Worksheet
Dim Destination As Worksheet
Dim Orig As Range
Dim Dest As Range
Dim Tableau1() As String
Dim i As Long
Dim j As Long
Dim Derligne1 As Long
Set Origine = Worksheets("Feuil1")
Set Destination = Worksheets("Feuil2")
Set Orig = Origine.Range("A1")
Set Dest = Destination.Range("A1")
Orig = Orig.Offset()
Dest = Dest.Offset()
Dim Pass1 As Double
Dim Pass2 As Double
Pass1 = Timer
With Sheets("Feuil1")
    Derligne1 = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
 
 
ReDim Tableau1(0 To Derligne1)
 
For i = 0 To UBound(Tableau1)
Tableau1(i) = Orig.Offset(i, 0)
Next i
 
 
 
 i = 0
 j = 0
 
 Do While Tableau1(i) <> "" And Dest.Offset(j, 0) <> ""
 If Tableau1(i) = Dest.Offset(j, 0) Then
 Dest.Offset(j, 6) = Orig.Offset(i, 2)
    If Dest.Offset(j + 1, 0) = Dest.Offset(j, 0) Then
    i = i
    j = j + 1
    Else
    i = i + 1
    j = j + 1
    End If
 ElseIf (Dest.Offset(j, 0) - Orig.Offset(i, 0)) > "0,1" Then
 i = i + 1
 j = j
 Else
 i = i
 j = j + 1
 End If
 
 Loop
Pass2 = Timer
MsgBox Pass2 - Pass1 & " secondes "
End Sub

Cette macro marche!
Elle est juste très lente et j'aimerais la rendre plus rapide et en même temps, l'appliquer à tous les onglets.

Ce qu'elle fait:
J'ai 2 feuilles horodatées en ligne A.
La macro copie les cellules C de la feuille 1 vers les cellules G de la feuille 2, en fonction de l'horodatage des lignes.

Exemple:
Feuil1
Colonne A__________Colonne C
21/06/2014 19:20__________A
21/06/2014 19:30__________A
21/06/2014 19:40__________B
21/06/2014 19:50__________D
21/06/2014 20:00__________D

Feuil2
Colonne A__________ColonneG
21/06/2014 19:20__________A
21/06/2014 19:20__________A
21/06/2014 19:20__________A
21/06/2014 19:20__________A
21/06/2014 19:20__________A
21/06/2014 19:30__________A
21/06/2014 19:30__________A
21/06/2014 19:30__________A
21/06/2014 19:30__________A
21/06/2014 19:30__________A
21/06/2014 19:40__________B
21/06/2014 19:40__________B
21/06/2014 19:40__________B
21/06/2014 19:40__________B
21/06/2014 19:40__________B
21/06/2014 19:40__________B
21/06/2014 19:50__________D
21/06/2014 19:50__________D
21/06/2014 19:50__________D
21/06/2014 19:50__________D
21/06/2014 20:00__________D
21/06/2014 20:00__________D

**vinc_bilb** · 21/05/2015, 16h15

Bonjour,

Le code est .... oui, franchement optimisable

Vous pourriez m'expliquer comment vous passer de la feuille1 à la feuille2: les enregistrements se rajoutent aux existants?
Si vous avez un exemple à fournir, c'est encore mieux

**Identifiant75** · 21/05/2015, 16h25

Je vous créer une feuille exemple et je vous l'envoi, par contre le fichier sera trop volumineux pour ce forum.

Comment procéder ?

Cdt,

**vinc_bilb** · 21/05/2015, 16h29

et bien ..... bien purgé peut-être

**Identifiant75** · 21/05/2015, 16h51

Voici le fichier avant lancement de la macro (la macro prend environ 1H à s’exécuter)

https://www.transfernow.net/fr/33bbr4d8bajz

Prévenez moi si impossibilité de télécharger le fichier exemple.

Cdt,

**vinc_bilb** · 22/05/2015, 15h31

Bonjour,

Et bien je ne comprends pas tout .... avec quelques questions, sachant que je n'ai pas tout compris comment marche votre code

1. Feuille 1
Vous avez des données du style
$A$1 6/15/2014 3:00:13 AM
$A$2 6/15/2014 3:10:15 AM
=> Est-ce-que vous faites un traitement dessus?

2. Feuille 2
=> Je n'ai pas compris exactement ce que vous vouliez faire avec les enregistrements dans votre partie

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
 Do While Tableau1(i) <> "" And Dest.Offset(j, 0) <> ""
 If Tableau1(i) = Dest.Offset(j, 0) Then
 Dest.Offset(j, 6) = Orig.Offset(i, 2)
    If Dest.Offset(j + 1, 0) = Dest.Offset(j, 0) Then
    i = i
    j = j + 1
    Else
    i = i + 1
    j = j + 1
    End If
 ElseIf (Dest.Offset(j, 0) - Orig.Offset(i, 0)) > "0,1" Then
 i = i + 1
 j = j
 Else
 i = i
 j = j + 1
 End If
 
 Loop

Je vous propose déjà un embryon de code qui simplifie un peu:

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
Sub SolProp_Vinc1()
 
Dim InpRng As Range, ResRng As Range, InpCl As Range, ResCl As Range
Dim ResClFirstAddr As String
 
 
'On initalise les range Entrée données et résults
    Set InpRng = ThisWorkbook.Worksheets(1).Range("A1").CurrentRegion.Columns(1)    'On prend la 1ere colonne de tous les enregistrements
    Set ResRng = ThisWorkbook.Worksheets(2).Range("A1").CurrentRegion
 
Debug.Print InpRng.Address, ResRng.Address
 
' On Parcout toutes les cellules de InpRng
    For Each InpCl In InpRng.Cells
 
        Debug.Print InpCl.Address, InpCl.Value
 
    ' On cherche celles correspondantes dans ResRng (1ere colonne)
        With ResRng.Columns(1)
 
            Set ResCl = .Find(InpCl.Value, LookIn:=xlValues)
 
            If Not ResCl Is Nothing Then
                ResClFirstAddr = ResCl.Address
 
                Do
                    ResCl.Value = ResCl.Value   'Quelquechose à modifier ici
                    Set ResCl = .FindNext(ResCl)
 
                Loop While Not ResCl Is Nothing And ResCl.Address <> ResClFirstAddr
 
            End If
 
        End With
 
    Next InpCl
 
End Sub

**joe.levrai** · 22/05/2015, 15h52

Bonjour,

j'avais bien une méthode rapide à proposer et qui utilise des tableaux virtuels ... mais dans la mesure où on a des dates en Feuil2 pour laquelle il n'existe pas de correspondance en Feuil1 .... le programme tournait en 0.4s et remplissait uniquement les 3900 premières lignes ... il faut voir comment tu gères ce cas du coup.
En extrapolant par pessimisme, on pouvait s'attendre à un traitement en quelques minutes

une autre méthode envisageable :

- pour chaque ligne de référence de la feuille1
- filtre automatique en feuille2 avec la valeur
- remplissage de la données en colonne G pour les lignes visibles
- passage à la ligne suivante.

mais ça représente 19500 Autofilters à effectuer ...

j'ai encore d'autres méthode, puisque tes données sont triées ... mais encore une fois le fait qu'il manque des heures de références gâche toute l'optimisation

**Identifiant75** · 22/05/2015, 16h21

Bonjour,

1. Feuille 1
Vous avez des données du style
$A$1 6/15/2014 3:00:13 AM
$A$2 6/15/2014 3:10:15 AM
=> Est-ce-que vous faites un traitement dessus?

Tout d'abord j'effectue une action manuelle sur ces données qui consiste a supprimer les milliseconde.

Cela permet d'avoir le meme horodatage en feuille 1 et en feuille 2. Car les millisecondes ne sont pas identiques entre les deux.

J'active ensuite la macro.

2. Feuille 2
=> Je n'ai pas compris exactement ce que vous vouliez faire avec les enregistrements dans votre partie

Je ne suis pas l'auteur de cette macro, je suis donc dans l'imposibilité de décrire son fonctionnement...

Je ne suis pas d'une grande aide, j'en suis conscient et désolé..

mais dans la mesure où on a des dates en Feuil2 pour laquelle il n'existe pas de correspondance en Feuil1 ....

Les dates en feuille 2 avec un horodatage contenant des minutes différentes de 00 10 20 30 40 50, sont des erreurs.

Je m'en suis rendu compte après l'envoi du fichier. Sans ces horodatages il y aurait une correspondance pour chaque horodatage.

Donc peut etre que votre solution fonctionnerait.
(I faut juste supprimer le 23/06)

Cordialement,

Voici le lien du fichier sans l'erreur au niveau de l'horodatage.

https://www.transfernow.net/fr/717ii362t89j

**vinc_bilb** · 22/05/2015, 16h57

Rebonjour

Tout d'abord j'effectue une action manuelle sur ces données qui consiste a supprimer les milliseconde.

=> Horreur et stupéfaction! VBA sait très bien le faire, et excel aussi!

Je ne suis pas l'auteur de cette macro, je suis donc dans l'imposibilité de décrire son fonctionnement...

=> OK, mais si vous pouviez décrire un peu (avec des mots, désolé, je nai toujours pas compris) ce que vous attendez de la Macro:
- Si l'enregistrement en feuil1 est trouvé, je fais quoi (enregistrements multiples, ....)
- Sinon ....

Bon WE

**Identifiant75** · 22/05/2015, 17h13

OK, mais si vous pouviez décrire un peu (avec des mots, désolé, je nai toujours pas compris) ce que vous attendez de la Macro:
- Si l'enregistrement en feuil1 est trouvé, je fais quoi (enregistrements multiples, ....)
- Sinon ....

Alors je vais vous expliquer le contexte et ce que je veux faire:

En feuille 1 j'ai toutes les 10 min 1 données X
En feuille 2 j'ai toutes les 10 min 20 données Y

Ce que je veux c'est faire apparaître les données X (sur la feuille 2) correspondantes aux données Y en fonction de l'horodatage.

Manuellement ca donnerait:
(On considère que les données X sont en colonne C (feuille1) et les données Y en colonne D (feuille2))

Je copie la donnée X de la ligne 1, feuil 1
Je la colle sur la ligne 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 , feuille 2 colonne E (à coté des données Y)

Je copie la donnée X de la ligne 2, feuil 1
Je la colle sur la ligne 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 , feuille 2

(vous devriez lancer la macro sur une partie de la feuille que je vous ai fourni, ca devrait être plus clair.)

N'hésitez pas a me requestionner si vous n'avez toujours pas compris ce que la macro doit faire.

Cordialement,

Macro de recopiage de données sur lignes spécifiques [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager