Ajout d'info à un fichier codé

Question

Je reçois régulièrement un fichier excel qui contient des informations codés que je dois étayer afin d'être utile pour consultation. Je désire faire une macro qui me sauverait plusieurs heures de travail fastidieux. Étape 1: La col. A du feuillet databrut donne les identificateurs de stations. Je cherche une macro qui ajouterait dans les colonnes suivantes le ID: le nom, la région et les coord. de la station (spécifiée dans le feuillet IDENT). À noter qu'il est possible que certains ID soient absents du feuillet: IDENT. Étape 2. Les données propre aux stations se trouvent aux col. D,E,F,.... La macro doit donner des couleurs à ces données selon la lettre qui suit à la col. suivante. Je joins un fichier simplifié avec des explications suppl. Je vous remercie d'Avance pour votre aide. JL...

vba-new · Answer

Ya eu un problème dans la jonction de ton fichier. Il faudrait que tu y remédies...

vba-new · Answer

Re,

Il y avait une petite erreur auparavant. Tu l'as apparemment réglée.

Pour ta demande, voici la macro qui_fait_tout !

Sub qui_fait_tout()
Dim dercol As Long, derlign As Long, j As Integer, i As Long, cpt As Byte

    On Error GoTo fin
    If Not ThisWorkbook.Sheets("databrut2") Is Nothing Then
        Application.ScreenUpdating = False    'désactive la mise à jour de l'écran
        Application.DisplayAlerts = False    'Ici, pour éviter message d'alerte lors de la suppression d'une feuille
        On Error Resume Next
        Sheets("final").Delete    'on supprime la feuille "Final"
        Sheets.Add after:=Sheets("databrut2")    'on crée une nouvelle feuille
        ActiveSheet.Name = "final"    'que l'on nomme "final"

        With Sheets("databrut2")
            dercol = .Range("IV1").End(xlToLeft).Column    'dernière colonne de la feuille "databrut2"
            derlign = .Range("A65536").End(xlUp).Row    'dernière ligne de la feuille "databrut2"
            .Range("A1:A" & derlign).Copy _
                    Destination:=Sheets("final").Range("A2")    'on copie la colonne A vers la feuille "final"
            .Range(.Cells(1, 2), .Cells(derlign, dercol)).Copy _
                    Destination:=Sheets("final").Range("G2")    'on copie les colonnes B jusqu'à ... vers la feuille "final"
        End With

        With Sheets("final")
            .Range("A1:H1") = Array("ID", "Nom de la station", "région", "Lat", "Long", "Elev", "an/mois", "T")    'création de la ligne de titre

            With .Range(Cells(1, 1), Cells(1, dercol + 5))    'mise en forme de la ligne de titre
                .Interior.ColorIndex = 15
                .HorizontalAlignment = xlCenter
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
            End With

            'on crée les formules pour avoir les détails de chaque ID (Station, région...)
            .Range("B2").FormulaR1C1 = _
            "=IF(ISNA(VLOOKUP(RC1,IDENT!R2C1:R5C6,COLUMNS(R2C1:RC),FALSE)),""Non-disponible"",VLOOKUP(RC1,IDENT!R2C1:R5C6,COLUMNS(R2C1:RC),FALSE))"
            .Range("B2").AutoFill Destination:=Range("B2:B" & derlign + 1)
            .Range("B2:B" & derlign + 1).AutoFill Destination:=Range("B2:F" & derlign + 1)

            'la boucle suivante permet d'attribuer les couleurs aux données
            For j = 9 To dercol + 4
                If j Mod 2 <> 0 Then Cells(1, j) = cpt + 1: cpt = cpt + 1
                For i = 2 To derlign + 1
                    If .Cells(i, j + 1) = "T" Then
                        .Cells(i, j).Interior.ColorIndex = 36
                    ElseIf .Cells(i, j + 1) = "C" Then
                        .Cells(i, j).Font.ColorIndex = 3
                    ElseIf .Cells(i, j + 1) = "E" Then
                        .Cells(i, j).Font.ColorIndex = 4
                    ElseIf .Cells(i, j) = -99999 Then
                        .Cells(i, j) = 0: .Cells(i, j).Interior.ColorIndex = 15
                    End If
                Next i
            Next j

            .Range(Cells(2, 9), Cells(derlign + 1, dercol + 4)).HorizontalAlignment = xlCenter    'centrage de quelques colonnes
            Cells.EntireColumn.AutoFit    'ajustement de la taille des colonnes
            .Range(Columns(9), Columns(dercol + 5)).ColumnWidth = 4.14

            'on met des bordures
            With .UsedRange
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
            End With
        End With
    End If
    Exit Sub

fin:
    MsgBox "la feuille databrut2 n'existe pas", vbExclamation
End Sub

JLMoreau a écrit :
Je désire faire une macro qui me sauverait plusieurs heures de travail fastidieux.

Suffit d'un peu moins de 2 centièmes de secondes de travail (sans compter le temps pour lancer la macro) et le tour est joué ! Elle est pas belle la vie ?

Avec en prime : quelques commentaires pour mieux comprendre les différents codes, une macro qui marche quelque soit le nombre de colonnes (puisque tu en as enlevé, on ne sait pas combien y'en a), et 2-3 autres bricoles...

Quelques préconisations :

la feuille "databrut2" doit toujours exister et ne contenir que les données brutes (dans le fichier joint, j'ai enlevé les données inutiles pour l'exécution de la macro)
s'il y a une feuille nommée "final", elle est supprimée. Une nouvelle feuille "final" est créée qui contiendra les données brutes retravaillées.
les données brutes doivent garder la même structure (pas d'en-tête notamment)

S'il manque des trucs, ou si tu rencontres des problèmes, fais signe.

Le fichier :

16databrut2-v1.zip (13.14 Ko)

vba-new · Answer

C'est normal J'avais oublié que le tableau de la feuille IDENT était variable Voici la version corrigée : J'ai testé la macro avec environ 5000 lignes et 85 colonnes. La macro met environ 40 secondes chez moi. Il doit être possible de faire plus vite mais c'est toujours mieux que quelques heures Pour les débutants, 2 outils : l'enregistreur de macro et la touche F1 ! Tu enregistres les actions que tu fais puis tu regardes le code associé. Ça t'aidera déjà beaucoup ! Si dans le code créé, tu as du mal à comprendre, clique sur un mot et appuie F1. La plupart du temps l'aide de visual basic éclairera ta compréhension ! Si tu ne comprends vraiment pas, le forum est là pour ça. A+...