Mise à Jour Fichier excel

qwcio

XLDnaute Nouveau
Bonjour à tous,

Vrai novice en VB, cela fait 1 semaine que je traîne sur le internet pour m'aider, mais après l'essai de nombreux scripts trouvés ici ou là, sans obtenir le résultat attendu, je craque et m'adresse à vous directement.

Voici mon souhait, pourtant simple:
Un fichier excel qui doit être mis à jour par un fichier csv (celui est généré par un script de récupération de data sur mes serveurs linux).
Il ne s'agit pas de seulement importer le .csv (ça, avec une macro, j'avais réussi à le faire), mais vraiment une mise à jour, c'est à dire que seules les données nouvelles du .csv doivent être inscrites dans le fichier excel (correction des données pour celles déjà existantes si nécessaire, + import des nouvelles lignes).

Donc il ne faut pas qu'il y ait écrasement des anciennes datas déjà présentes dans le fichier excel (car dans le fichier excel, certaines colonnes contiennent des données "manuelles" qu'on ne retrouve dans le fichier csv).


En gros, voici à quoi devrait ressembler le fichier excel:
Nom de l'application | Code ID | Commentaire | Port | Diag
toto | 28 | fait du toto | 12100 | OK
tata | 32 | remplace tata | 1100 | KO


Et pour le .csv:
toto;28;;12100;OK
tata;32;;1100;KO


Et donc, si le .csv futur est de ce type:
toto;30;;12100;OK
tata;32;;1100;OK
titi;45;;13500;Error

Le fichier excel devra automatiquement se mettre ainsi:
Nom de l'application | Code ID | Commentaire | Port | Diag
toto | 30 | fait du toto | 12100 | OK
tata | 32 | remplace tata | 1100 | OK
titi | 45 | déploie titi | 13500 | Error


Pour information (et je pense que pour les boucles de recherche pour faire des maj c'est important), le nom de l'application n'est jamais variant.


Voilà toutes propositions sera la bienvenue.
Et merci d'avance.
 

Dranreb

XLDnaute Barbatruc
Re : Mise à Jour Fichier excel

Alors une procédure à tester :
VB:
Sub LectCsv(Ts(), ByVal RéfFic As String)
Dim Te() As String, L&, TSpl() As String, C&, V
Open RéfFic For Input As #1
While Not EOF(1): L = L + 1: ReDim Preserve Te(1 To L)
   Line Input #1, Te(L): Wend
Close #1
ReDim Ts(1 To L, 1 To 1)
For L = 1 To UBound(Ts, 1)
   TSpl = Split(Te(L), ";")
   If UBound(TSpl) + 1 > UBound(Ts, 2) Then ReDim _
      Preserve Ts(1 To UBound(Ts, 1), 1 To UBound(TSpl) + 1)
   For C = 0 To UBound(TSpl): V = TSpl(C): If IsNumeric(V) Then V = CDbl(V)
      Ts(L, C + 1) = V: Next C, L
End Sub
 

qwcio

XLDnaute Nouveau
Re : Mise à Jour Fichier excel

Là, il y a quelquechose que je ne comprends clairement pas dans ton code.

J'ai mis la boucle sur C plus haut, et cela semble fonctionner pour l'import du feuillet csv.
Mais il efface toutes les colonnes "manuelles".

Voici ce que j'ai fait:
VB:
Sub MàJ()
Dim Te(), Ts(), App As SsGroup, Ls&, Détail, C&
Te = TableUnique(PlgUti(FBdD.[A2]), PlgUti(FDonCSV.[A2]))
ReDim Ts(1 To UBound(Te, 1), 1 To UBound(Te, 2))
For Each App In GroupOrg(Te, 1)
   Ls = Ls + 1: Ts(Ls, 1) = App.Id
   For C = 1 To UBound(Ts, 2)
   For Each Détail In App.Contenu
      If Détail(0) = 0 Then
         Ts(Ls, C) = Détail(C)
      Else
         Ts(Ls, C) = Détail(C)
         
         End If: Next Détail, C, App
FBdD.Rows(2).Resize(1000).Delete
FBdD.[A2].Resize(Ls, UBound(Ts, 2)) = Ts

End Sub
 

qwcio

XLDnaute Nouveau
Re : Mise à Jour Fichier excel

Alors une procédure à tester :
VB:
Sub LectCsv(Ts(), ByVal RéfFic As String)
Dim Te() As String, L&, TSpl() As String, C&, V
Open RéfFic For Input As #1
While Not EOF(1): L = L + 1: ReDim Preserve Te(1 To L)
   Line Input #1, Te(L): Wend
Close #1
ReDim Ts(1 To L, 1 To 1)
For L = 1 To UBound(Ts, 1)
   TSpl = Split(Te(L), ";")
   If UBound(TSpl) + 1 > UBound(Ts, 2) Then ReDim _
      Preserve Ts(1 To UBound(Ts, 1), 1 To UBound(TSpl) + 1)
   For C = 0 To UBound(TSpl): V = TSpl(C): If IsNumeric(V) Then V = CDbl(V)
      Ts(L, C + 1) = V: Next C, L
End Sub


Je mets ce Sub à la place du Sub MàJ, ou c'est un sub en plus auquel je dois attribuer un bouton qui sert à import le tableau VBA?
 

Dranreb

XLDnaute Barbatruc
Re : Mise à Jour Fichier excel

C'est une sub en plus pour fabriquer le 2ième tableau passé en 2ième paramètre de la function TableUnique.
Mais testez la d'abord dans une procédure d'essais avant d'assembler le tout dans le dispo définitif.

Étudiez l'explication de cette fonction:
Rem. —— Renvoie un tableau unique où sont empilés l'un derrière l'autre plusieurs tableaux de
' diverses sources. La seconde dimension des différents tableaux doit commencer à 1.
' Cependant dans le tableau résultant elle commencera à 0, l'élément 0 restituant le
' numéro d'ordre de la source
, commençant à 0 pour la 1ère.
Cela signifie par la suite et de fil en aiguille que :
If Détail(0) = 0 Then doit être suivi des instructions qui récupèrent seulement les infos manuelles ajoutées dans la base et que le Else doit être suivi des instructions qui récupèrent seulement les infos du CSV
 
Dernière édition:

qwcio

XLDnaute Nouveau
Re : Mise à Jour Fichier excel

Étudiez l'explication de cette fonction:. Cela signifie par la suite et de fil en aiguille que :
If Détail(0) = 0 Then doit être suivi des instructions qui récupères seulement les infos manuelles ajoutées dans la base et que le
Else doit être suivi des instructions qui récupères seulement les infos du CSV

Donc si je comprends bien, il faudrait que je mettes à la suite du then toutes les colonnes remplies manuellement du style:
If Détail(0) = 0 Then
Ts(Ls, 3) = Détail(3)
Ts(Ls, 8) = Détail(8)
(j'ai essayé en effet cela fonctionne).

Mais si je comprends le fonctionnement du TableUnique, il empile l'un derrière l'autre les 2 tableaux (le csv et le base).
Du coup, a priori, dans la boucle, quand C = 3, alors que je mettes Ts(Ls,3) = Détail(3) ou Ts(Ls,C) = Détail(C), alors le résultat devrait être identique non?

Ou alors comme TableUnique empile les 2 tableaux, il faut décaler dans le cas ou détail(0) = 0, du style:
Ts(Ls, C) = Détail(X + C)

En fait je n'arrives vraiment pas à appréhender pourquoi quand C = 3 dans le tour de boucle, alors les 2 commandes (renvoient Ts(Ls,3) = Détail(3) ou Ts(Ls,C) = Détail(C)) un résultat différent alors qu'en apparence elles ont les mêmes indications.
 

qwcio

XLDnaute Nouveau
Re : Mise à Jour Fichier excel

Pour le sub LectCsv, je l'ai mis dans un nouveau module, mais quand je l’exécutes, il m'ouvre la fenêtre de macro.

Mais je me demandes si c'est tout simplement parce que le RéfFic ne référence à rien.
Je dois peut-être lui définir l'emplacement du fichier .csv non?
 

Dranreb

XLDnaute Barbatruc
Re : Mise à Jour Fichier excel

il empile l'un derrière l'autre les 2 tableaux (le csv et le base).
C'est ce que j'avais d'abord dit. J'ai opté pour en 1er le base (0) puis le csv (1)

Oui si C vaut 3 c'est comme avec 3. C'est jusque que si Détail(0) = 1 ça vient du csv, où c'est vide, et que ça écrase donc ce qui venait du Détail(0) = 0.

Ça ne me parait pas judicieux d'avoir mis le For C = 1 To UBound(Ts, 2) plus haut.

Oui, il faut évidemment écrire une Sub Test qui appelle LectCsv avec les arguments appropriés, et verse éventuellement le tableau récupéré dans une plage, pour vérifier.
 
Dernière édition:

qwcio

XLDnaute Nouveau
Re : Mise à Jour Fichier excel

C'est ce que j'avais d'abord dit. J'ai opté pour en 1er le base (0) puis le csv (1)

Oui si C vaut 3 c'est comme avec 3. C'est jusque que si Détail(0) = 1 ça vient du csv, où c'est vide, et que ça écrase donc ce qui venait du Détail(0) = 0.

Ça ne me parait pas judicieux d'avoir mis le For C = 1 To UBound(Ts, 2) plus haut.

Ok je comprends mieux.
En fait quand je pensais que C = 3, en réalité la boucle en était à C + Colonnes de DB.
Merci pour ton explication.


Oui, il faut évidemment écrire une Sub Test qui appelle LectCsv avec les arguments appropriés, et verse éventuellement le tableau récupéré dans une plage, pour vérifier.

OK, j'essaye de faire ça.
 

qwcio

XLDnaute Nouveau
Re : Mise à Jour Fichier excel

Alors voici ce que j'ai réussi à faire:

Alors voilà ce que j'ai fait:

VB:
Sub LectCsv()
Dim Ts(), Te() As String, L&, TSpl() As String, C&, V
Sheets.Add
ActiveSheet.Name = "Test"
Open "I:\toto\CSV.csv" For Input As #1
While Not EOF(1): L = L + 1: ReDim Preserve Te(1 To L)
   Line Input #1, Te(L): Wend
Close #1
ReDim Ts(1 To L, 1 To 1)
For L = 1 To UBound(Ts, 1)
   TSpl = Split(Te(L), ";")
   If UBound(TSpl) + 1 > UBound(Ts, 2) Then ReDim _
      Preserve Ts(1 To UBound(Ts, 1), 1 To UBound(TSpl) + 1)
   For C = 0 To UBound(TSpl): V = TSpl(C): If IsNumeric(V) Then V = CDbl(V)
      Ts(L, C + 1) = V: Next C, L

Test.Rows(2).Resize(1000).Delete
Test.[A2].Resize(L - 1, UBound(Ts, 2)) = Ts
End Sub

VB:
Sub MàJ()
LectCsv
Dim Te(), Ts(), App As SsGroup, Ls&, Détail, C&
Te = TableUnique(PlgUti(FBdD.[A2]), PlgUti(Test.[A2]))
ReDim Ts(1 To UBound(Te, 1), 1 To UBound(Te, 2))
For Each App In GroupOrg(Te, 1)
   Ls = Ls + 1: Ts(Ls, 1) = App.Id
   For C = 1 To UBound(Ts, 2)
   For Each Détail In App.Contenu
      If Détail(0) = 0 Then
         Ts(Ls, 3) = Détail(3)
      Else
         Ts(Ls, C) = Détail(C)
         End If: Next Détail, C, App
FBdD.Rows(2).Resize(1000).Delete
FBdD.[A2].Resize(Ls, UBound(Ts, 2)) = Ts
Sheets("Test").Delete
Application.DisplayAlerts = False
End Sub


Quand je lances le Sub, il ne crée pas le feuillet "Test". Mais lorsque j'avais fait le test avec le feuillet Test déjà existant (et donc en retirant tout ce qui fait référence à sa création), la fonction importait bien les données du fichier csv.
De plus, j'ai l'impression que j'appelle la fonction LectCsv n'importe comment puisque quand je lance la fonction MàJ, il ne se passe rien du tout.
 

Dranreb

XLDnaute Barbatruc
Re : Mise à Jour Fichier excel

Vous avez supprimé les paramètres de LectCsv, alors on ne peut plus lui spécifier dans MàJ le tableau à restituer afin de le ré-indiquer comme deuxième paramètre à TableUnique.

Essayez comme ça :
VB:
Sub MàJ()
Dim TCsv(), Te(), Ts(), App As SsGroup, Ls&, Détail, C&
LectCsv TCsv, "I:\toto\CSV.csv"
Te = TableUnique(PlgUti(FBdD.[A2]), TCsv)
ReDim Ts(1 To UBound(Te, 1), 1 To UBound(Te, 2))
For Each App In GroupOrg(Te, 1)
   Ls = Ls + 1: Ts(Ls, 1) = App.Id
   For Each Détail In App.Contenu
      If Détail(0) = 0 Then
         Ts(Ls, 3) = Détail(3)
      Else
         Ts(Ls, 2) = Détail(2)
         For C = 4 To UBound(Ts, 2)
            Ts(Ls, C) = Détail(C): Next C: End If: Next Détail, App
FBdD.Rows(2).Resize(1000).Delete
FBdD.[A2].Resize(Ls, UBound(Ts, 2)) = Ts
Sheets("Test").Delete
Application.DisplayAlerts = False
End Sub

Sub LectCsv(Ts(), ByVal RéfFic As String)
Dim Te() As String, L&, TSpl() As String, C&, V
Open RéfFic For Input As #1
While Not EOF(1): L = L + 1: ReDim Preserve Te(1 To L)
   Line Input #1, Te(L): Wend
Close #1
ReDim Ts(1 To L, 1 To 1)
For L = 1 To UBound(Ts, 1)
   TSpl = Split(Te(L), ";")
   If UBound(TSpl) + 1 > UBound(Ts, 2) Then ReDim _
      Preserve Ts(1 To UBound(Ts, 1), 1 To UBound(TSpl) + 1)
   For C = 0 To UBound(TSpl): V = TSpl(C): If IsNumeric(V) Then V = CDbl(V)
      Ts(L, C + 1) = V: Next C, L
End Sub
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 677
Messages
2 090 832
Membres
104 677
dernier inscrit
soufiane12