Archivage journalier vba

Version imprimable

19/01/2015, 11h34
moteuv12

Archivage journalier vba

Bonjour le Forum,

Ci-joint le fichier.
le but, archiver certaines lignes de "synthese" vers "archives" fin de fichier compte tenu que la feuille archive est maître et contient les noms à sauvegarder.

Le problème. J'avais fait une boucle qui fonctionnait parfaitement jusqu'en ce début d'année ou les sites ou je récupère les données ont changer certaines valeurs, on changer l'ordonnancement, et modifié l'écriture de certains noms, et ceci parfois d'un jour sur l'autre.

J'ai donc écrit une moulinette dont le fichier joint est le résultat, reste plus qu'a archiver les données.
Les emplacements et lignes ne sont jamais les mêmes d'un jour à l'autre et je n'arrive plus à stocker les données en fin de journée.

A+ de vous lire si une piste.
19/01/2015, 12h27
Daniel.C

Bonjour,

Qu'est-ce qu'il y a à archiver dans ce cas précis ?
19/01/2015, 12h28
deedolith

Avec juste le "resultat", "certaines lignes", "certaines valeurs", sans les données d'entrée, sans les règles de gestion, sans ta "moulinette", il est quasi impossible de t'aider, on ne peut deviner ce qui se passe avec un simple rapport, bref il va faloir être beaucoup plus précis.

A vu de nez, ta moulinette a un comportement rigide, que tu devras adapter, voir rendre plus souple.
19/01/2015, 12h46
moteuv12

Citation:

Envoyé par Daniel.C

Bonjour,

Qu'est-ce qu'il y a à archiver dans ce cas précis ?

Il faut archiver la liste de la feuille archive à partir de Y5

Citation:

Envoyé par deedolith

Avec juste le "resultat", "certaines lignes", "certaines valeurs", sans les données d'entrée, sans les règles de gestion, sans ta "moulinette", il est quasi impossible de t'aider, on ne peut deviner ce qui se passe avec un simple rapport, bref il va faloir être beaucoup plus précis.

A vu de nez, ta moulinette a un comportement rigide, que tu devras adapter, voir rendre plus souple.

Je ne suis pas contre le fait d'envoyer le fichier complet si tu le désire (4 mo), dis moi
19/01/2015, 13h15
deedolith

Commence déja par préciser ton besoin, car la, c'est confus.

S'ajit-il de copier (ou deplacer) des données de la feuille "Synthese" vers la feuille "Archive" ? Si oui, selon quels critères ?
Ou s'ajit-il d'archiver des données de la feuille "Archive" ? si oui, quels critères ? Et que veux tu dire par archiver ?
Si non, donne nous des explications supplémentaires, qu'as tu deja fait ? Peux-tu poster un extrait de code ?
19/01/2015, 14h05
moteuv12

Il s'agit de copier les données de synthese ( prono de 8 chevaux) dans la feuille archive en s'indexant sur la ligne 5 de cette feuille archive à partir de la colonne Y ou se trouvent les noms des pronostiqueurs à archiver.
Dans la feuille synthese les pronos ne sont quasiment jamais plus à la même place et des fluctuations ont lieu dans l'écriture du nom des pronostiqueurs.

La feuille synthese est déjà triée au niveau des doublons, si doublons apparents c'est que le prono n'est pas le même ( voir pour un nom identique si les 8 chiffres sont aussi identiques)

Si les entêtes de la feuille ARCHIVES correspondaient à la colonne F de SYNTHESE, on pourrait utiliser :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Archiver()
    Dim Plage As Range, C As Range, Ligne As Long, Col As Variant
    With Sheets("SYNTHESE")
        Set Plage = .Range("F3", .Cells(.Rows.Count, 6).End(xlUp))
    End With
    With Sheets("ARCHIVES")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
        For Each C In Plage
            Col = Application.Match(C.Value, .[5:5], 0)
            If IsNumeric(Col) Then
                For i = 1 To 8
                    .Cells(Ligne, Col + i - 1) = C.Offset(, i)
                Next i
            End If
        Next C
    End With
End Sub

mais ce n'est pas systématique. Et sans ta moulinette...

19/01/2015, 15h42
moteuv12

Voici le fichier complet avec le code.
Soit indulgent sur la qualité du codage:oops:
19/01/2015, 17h00
Daniel.C

Bon. Tu enlèves tout ce qui ne sert pas à résoudre le problème (feuilles, macros) et tu postes un classeur ne contenant que l'essentiel. Supprime ta dernière pièce jointe.

Je recapitule, dans la feuille SYNTHESE
Tu as un tableau avec en colonne le nom du pronostiqueur et ses 8 pronostiques, commencant a la colonne F, ligne 5, donc une cellule de depart (objet range): F5
J'assume que la fin du tableau est inconnue, cependant la methode range("F5").End(xlDown).row te donnera la dernière ligne.
Il ne reste plus qu'a boucler pour parcourir tes données:

Dans la feuille ARCHIVES:
Tu dois rechercher le nom du pronostiqueur.
Tu dois rechercher la derniere ligne + 1 du pronostiqueur.
Tu dois recopier le pronostique.

Le code suivant devrais t'aider.

Code:

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
 
Option Explicit
 
Public Sub test()
On Error GoTo Error
    Dim oSheet As Worksheet         '// feuille de travail
    Dim oRow As Range               '// iterateur
    Dim oCellStart As Range         '// cellule de depart
    Dim lMaxRow As Long             '// N° de la derniere ligne
    Dim oPronosticRange As Range    '// pronostiqueur + pronostique
    Dim oCell As Range
 
        '// init feuille de travail
    Set oSheet = ThisWorkbook.Sheets("SYNTHESE")
        '// init cellule de depart
    Set oCellStart = oSheet.Range("F5")
        '// ligne de fin
    lMaxRow = oCellStart.End(xlDown).Row
 
        '// parcours des pronostiques
    Set oPronosticRange = oSheet.Range("F5:N" & lMaxRow)
 
    For Each oRow In oPronosticRange.Rows
        Call copyPronostic(oRow)
    Next
    Set oPronosticRange = Nothing
    Set oCellStart = Nothing
    Set oSheet = Nothing
Exit Sub
Error:
    '// gestionnaire d'erreur
        '// nettoyage
    If Not (oPronosticRange Is Nothing) Then
        Set oPronosticRange = Nothing
    End If
    If Not (oCellStart Is Nothing) Then
        Set oCellStart = Nothing
    End If
    If Not (oSheet Is Nothing) Then
        Set oSheet = Nothing
    End If
        '// action supplémentaire eventuelles
    Debug.Print "test: Erreur N°" & Err.Number & " " & Err.Description
End Sub
 
    '// recopie les pronostiques
Private Sub copyPronostic(ByRef oRow As Range)
On Error GoTo Error
    Dim oSheet As Worksheet     '// feuille de travail
    Dim oWorkRange As Range     '// plage de cellules pronostique
    Dim oCellStart As Range     '// cellule de depart
    Dim i As Long               '// compteurs
    Dim j As Long
 
        '// init feuille de travail
    Set oSheet = ThisWorkbook.Sheets("ARCHIVES")
        '// recherche cellule de depart
    Set oCellStart = oSheet.Cells.Find(oRow.Cells(1).Text)
        '// recherche fructueuse ?
    If Not (oCellStart Is Nothing) Then
            '// init plage des cellules pronostique
        Set oWorkRange = oCellStart.End(xlDown)
        If (oWorkRange.Row = oSheet.Rows.Count) Then
            Set oWorkRange = oCellStart.Offset(1)
        Else
            Set oWorkRange = oWorkRange.Offset(1)
        End If
        Set oWorkRange = oSheet.Range(oWorkRange, oWorkRange.Offset(0, 7))
            '// recopie les pronostiques
        i = 1
        For j = 2 To oRow.Cells.Count
            oWorkRange.Cells(i).Value = oRow.Cells(j).Value
            i = i + 1
        Next
            '// nettoyage
        Set oWorkRange = Nothing
        Set oCellStart = Nothing
    End If
    Set oSheet = Nothing
Exit Sub
Error:
    '// gestionnaire d'erreur
        '// nettoyage
    If Not (oWorkRange Is Nothing) Then
        Set oWorkRange = Nothing
    End If
    If Not (oCellStart Is Nothing) Then
        Set oCellStart = Nothing
    End If
    If Not (oSheet Is Nothing) Then
        Set oSheet = Nothing
    End If
        '// action supplémentaire eventuelles
    Debug.Print "copyPronostic: Erreur N°" & Err.Number & " " & Err.Description
End Sub

20/01/2015, 08h06
moteuv12

Vraiment pas mal et instructif, mais le résultat n'est pas celui attendu, il doit classer pour chaque prono alors que là il peu rajouter plusieurs lignes si un nom de pronostique est ressemblant voir photo

Pièce jointe 166638

Pièce jointe 166638

Il va falloir que je différencie le nommage de Week End et Week End si les pronos sont différents sinon c'est pas possible de solutionner, je cogite 5 minutes

2 pronos totalement différents
Le Télégramme
Le Télégramme de Brest

il classe les 2 au même endroit ce qui ne doit pas être ( voir photo ci dessus )

Merci Daniel.C, merci deedolith pour le coup de main.
Bonne journée à toutes et à tous.
20/01/2015, 10h06
deedolith

Citation:

Envoyé par moteuv12

2 pronos totalement différents
Le Télégramme
Le Télégramme de Brest

il classe les 2 au même endroit ce qui ne doit pas être ( voir photo ci dessus )

Le code que je t'ai fournit effectue une recherche basique, en clair il recherche si tout ou partie du nom du pronostiqueur se trouve dans la feuille SYNTHESES.
La methode Find possède de nombreus paramètres optionels, je te laisse les regarder en detail.
20/01/2015, 11h59
moteuv12

c'est ce que je fais, je te remercie beaucoup.

A++