Discussion :

[noobyone]

Bonjour

Après plusieurs heures de recherches et essais infructueux je me décide à demander un coup de main ou plutôt de souris et de clavier

Mon projet consiste à mettre a jour une feuille d'un classeur local avec un fichier de données qui m'est fourni par ma direction. L'architecture de mon classeur est F1 "Explications" (avec le bouton pour la macro), F2 "Liste", F3 "DataImport"
Je souhaite supprimer les lignes qui n'existent plus et ajouter les nouvelles, sans toucher aux modifications et ajouts manuels (dans certaines cellules)
L'idéal serait que le code fonctionne pour tout type de tableau, afin qu'il puisse être utilisé dans d'autres circonstances.

J'ai donc pris le parti de rechercher le fichier source de manière manuelle et de copier les données sur une feuille du classeur de travail.

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 RecupereDataFichier()
'Déclaration des variables
Dim ListeFichier As Variant
Dim MonClasseur As Workbook
 
 
'Desactivation du presse Papiers des messages d'alerte et du rafraichissement de l'écran
Application.CutCopyMode = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
 
'Efface les anciennes données
Worksheets("DataImport").Cells.ClearContents
 
'Recherche du fichier
ListeFichier = Application.GetOpenFilename(Title:="Sélectionnez le fichier", Buttontext:="Cliquez")
 
'Prevoir le cas du bouton annuler
If ListeFichier <> False Then
 
'On affecte le fichier sélectionné
Set MonClasseur = Application.Workbooks.Open(ListeFichier)
 
    'Copie des données de la feuille 1
    MonClasseur.Sheets(1).Range("A2").CurrentRegion.Copy
    'On colle les données dans la feuille DataImport
    ThisWorkbook.Worksheets("DataImport").Range("A1").PasteSpecial xlPasteValues
 
 
    'Fermeture du classeur source
    MonClasseur.Close
     Application.CutCopyMode = True
     Application.ScreenUpdating = True
    End If
 
    End Sub

Il me reste maintenant à supprimer les lignes obsolètes et ajouter les nouvelles de la feuille 3 "DataImport" à la feuille 2 "Liste". Et là rien de ce que j'ai essayé as fonctionné. Dans le cas précis sur lequel je travaille la colonne qui permet le "tri" est la colonne G de la feuille 2, mais idéalement j'aimerais que la "lettre" de la colonne qui serve au tri puisse être saisie dans la cellule L6 en feuille 1.

Merci d'avance de me filer un coup de main

[EricDgn]

Bonjour,

Une façon de faire:

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
Option Explicit
 
Sub MAJ()
   Dim wsExp As Worksheet, wsListe As Worksheet, wsData As Worksheet, rCell As Range
   Dim kR As Long, kRL As Long, kRD As Long
   Dim rListe As Range, rData As Range
   Dim sC As String
   '--- initialise
   Set wsExp = ThisWorkbook.Worksheets("Explications")
   Set wsListe = ThisWorkbook.Worksheets("Liste")
   Set wsData = ThisWorkbook.Worksheets("DataImport")
   sC = wsExp.Range("L6").Value                       '--- colonne de "tri"
   kRL = wsListe.UsedRange.Rows.Count
   kRD = wsData.UsedRange.Rows.Count
   '--- présume que les plages de données commencent en ligne n°1
   Set rListe = wsListe.Range(wsListe.Range(sC & "1"), wsListe.Range(sC & kRL))
   Set rData = wsData.Range(wsData.Range(sC & "1"), wsData.Range(sC & kRL))
   'Debug.Print rListe.Address, rData.Address
   '--- supprime lignes de "Liste" qui n'existent plus dans "DataImport"
   With rListe
      For kR = kRL To 1 Step -1                             '--- va en remontant
         If WorksheetFunction.CountIf(rData, .Cells(kR, 1)) = 0 Then
            .Cells(kR, 1).Interior.Color = vbRed
            '.Rows(kR).Delete Shift:=xlUp                    '--- supprime la ligne
         End If
      Next kR
   End With
   '--- ajoute lignes de "DataImport" qui n'existent pas dans "Liste"
   kRL = wsListe.UsedRange.Rows.Count
   With rData
      For kR = 1 To kRD
         If WorksheetFunction.CountIf(rListe, .Cells(kR, 1)) = 0 Then
            '.Cells(kR, 1).Interior.Color = vbYellow
            kRL = kRL + 1                                   '--- ligne suivante
            wsData.Rows(kR).Copy wsListe.Range("A" & kRL)   '--- copie la ligne
         End If
      Next kR
   End With
   '--- nettoie
   Set rListe = Nothing
   Set rData = Nothing
   Set wsListe = Nothing
   Set wsData = Nothing
   Set wsExp = Nothing
End Sub

mais personnellement, je n'aime pas supprimer des lignes "sans rien voir" (ligne 24), je préfère les "marquer" (ligne 23) pour les supprimer ensuite après vérification.

Cordialement.

[noobyone]

Bonjour
Cela fonctionne, mais il se passe quelque chose de gênant. A chaque utilisation de la macro des lignes vierges apparaissent entre les anciennes données et les nouvelles. Le plus étonnant est que le nombre de lignes vierges devient de plus en plus important à chaque utilisation.
De plus je ne sais pas comment enchainer les deux codes, j'ai essayé avec "next" en vain, du coup j'ai fait un deuxième module affecté à un deuxième bouton.

[EricDgn]

Bonjour,

Lancez cette macro:

Code :

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

1
2
3
Sub rUsed()
   ActiveSheet.UsedRange.Select
End Sub

et vérifiez que la plage sélectionnée ne reprend bien que celle des données, qu'il n'y a pas de ligne "non prévue". C'est en effet UsedRange qui sert de base à la mise à jour.

Cordialement.

[noobyone]

Bonjour

J'ai trouvé la raison, il s'agissait de la mise en forme que j'avais appliquée après la fin des données. Lorsque je laisse les cellules "vierges" cela marche très bien.
Par contre je rencontre deux difficultés:
* les nouvelles données ne sont pas collées dans le tableau, c'est bien collé sur la ligne d'après mais cella ne suffit pas pour utiliser les filtres de colonne
* sur certaines données collées il faut appliquer un format spécifique (date)

J'ai également identifié un besoin, que j'avais oublié.
Il faut mettre à jour des données sur des lignes déjà existantes, il s'agit de la colonne C. J'aimerais comme précédemment pouvoir l'identifier via la feuille 1 ('EXPLICATIONS') en cellule E3.
Dans ce cas serait il possible d'en mettre plusieurs ex: C,F,AB ?

merci d'avance !!
bonne journée

[EricDgn]

Bonjour,

Un début de solution travaillant sur des tableaux structurés, ce qui règle le problème de tri - filtration - formats conditionnels, mais ne gérant que 1 seule colonne mentionnée en E3, et donc à adapter pour le cas de plusieurs colonnes.

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
Sub MAJ_Tableau()
   '--- il est présumé que les colonnes sont exactement dans le même ordre dans les 2 tableaux
   Dim wsExp As Worksheet, loListe As ListObject, loData As ListObject
   Dim rCell As Range, kR As Long, kRL As Long, kRD As Long
   Dim kRdata0 As Long, kRliste0 As Long
   Dim rListe As Range, rData As Range, rValData As Range, rValListe As Range
   Dim sCid As String, sCval As String
   '--- initialise
   Set wsExp = ThisWorkbook.Worksheets("Explications")
   Set loListe = ThisWorkbook.Worksheets("Liste").ListObjects("Tableau1")
   Set loData = ThisWorkbook.Worksheets("DataImport").ListObjects("Tableau2")
   sCid = wsExp.Range("L6").Value            '--- titre colonne identifiant unique
   sCval = wsExp.Range("E3").Value           '--- titre colonne dont les valeurs sont à mettre à jour
   kRL = loListe.ListRows.Count + 1
   kRD = loData.ListRows.Count
   '--- plage de données de la colonne sCid
   Set rListe = loListe.ListColumns(sCid).Range
   Set rData = loData.ListColumns(sCid).Range
   Set rValListe = loListe.ListColumns(sCval).Range
   Set rValData = loData.ListColumns(sCval).Range
   kRdata0 = loData.HeaderRowRange.Row - 1
   kRliste0 = loListe.HeaderRowRange.Row - 1
   'Debug.Print rListe.Address, rData.Address
   '--- supprime lignes de "Liste" qui n'existent plus dans "DataImport"
   With rListe
      For kR = kRL To 1 Step -1                                '--- va en remontant
         Set rCell = rData.Find(.Cells(kR, 1).Value, , , xlWhole)
         If rCell Is Nothing Then
            '--- la ligne n'existe plus
            .Cells(kR, 1).Interior.Color = vbRed
            '.Rows(kR).Delete Shift:=xlUp                      '--- supprime la ligne
         Else
            '--- la ligne existe
            '--- reprend valeur de cellule du tableau Data dans tableau Liste
            rValListe.Cells(kR, 1).Value = rValData.Cells(rCell.Row - kRdata0, 1).Value
         End If
      Next kR
   End With
   '--- ajoute lignes de "DataImport" qui n'existent pas dans "Liste"
   kRL = loListe.ListRows.Count
   With rData
      For kR = 2 To kRD + 1
         Debug.Print .Cells(kR, 1)
         If WorksheetFunction.CountIf(rListe, .Cells(kR, 1)) = 0 Then
            '.Cells(kR, 1).Interior.Color = vbYellow
            kRL = kRL + 1                                               '--- n° ligne suivante
            loListe.ListRows.Add                                        '--- ajoute ligne au tableau
            '--- copie valeurs de toute la ligne du tableau Data dans tableau Liste
            loListe.ListRows(kRL).Range.Value = loData.ListRows(kR - 1).Range.Value
         End If
      Next kR
   End With
   '--- nettoie
   Set rCell = Nothing
   Set rValListe = Nothing
   Set rValData = Nothing
   Set rListe = Nothing
   Set rData = Nothing
   Set loListe = Nothing
   Set loData = Nothing
   Set wsExp = Nothing
End Sub

Bonne continuation.