[VB6 - VBS]additionRésolu

Question

Salut tout le monde,

J'ai un tableau avec :

cle1 6 2
cle2 2 4
cle3 5 9
cle2 7 3

Et j'aimerais :

cle1 6 2
cle2 9 7
cle3 5 9

C'est à dire garder que des clés uniques et additionner les valeurs des mêmes colonnes si elles sont en plusieurs exemplaires.

Tout fonctionne. A l'exception de l'addition...

For i=0 to Ubound(Tab3,1)
For j=0 to Ubound(Tab4,1)
If Tab4(j,0)=Tab3(i,0) Then
Tab4(j,1)= (Tab4(j,1)+Tab3(i,1))
Tab4(j,2)=Tab4(j,2)+Tab3(i,2)
Tab4(j,3)=Tab4(j,3)+Tab3(i,3)
Tab4(j,4)=Tab4(j,4)+Tab3(i,4)
Tab4(j,5)=Tab4(j,5)+Tab3(i,5)
Tab4(j,6)=Tab4(j,6)+Tab3(i,6)
Tab4(j,7)=Tab4(j,7)+Tab3(i,7)
Tab4(j,8)=Tab4(j,8)+Tab3(i,8)
Tab4(j,9)=Tab4(j,9)+Tab3(i,9)
Tab4(j,10)=Tab4(j,10)+Tab3(i,10)
Tab4(j,11)=Tab4(j,11)+Tab3(i,11)
Tab4(j,12)=Tab4(j,12)+Tab3(i,12)
End If
Next
Next

Dans mon premier exemple, cela me donne ça :

cle1 6 2
cle2 9 7
cle3 27 43

Il ne les additionne pas, mais les mets les uns après les autres...

Avez vous une idée ?

Merci

ucfoutu · Accepted Answer

Je remarque par ailleurs que ton exemple faisait état de trois colonnes, dont deux (la seconde et la troisième) contenant les valeurs à "additionner"
Je me demande pour le coup si, dans la réalité, tu n'aurais pas plus de 2 colonnes de valeurs à "additionner".
Autant alors prévoir cette éventualité d'ores et déjà, d'autant que la modif est très légère et ne mange pas de pain  ===>>
dim d,i,t,j,n, resultat
t = tableau
Set d = CreateObject("Scripting.Dictionary") 
For I = 0 To UBound(tableau)
  if not d.Exists(t(i,0)) then
    d.add tableau(i,0),i
    t(i,1) = tableau(i,1)
    t(i,2) = tableau(i,2)
   else
    ou = d(t(i,0))
    for j = 1 to ubound(tableau,2)
       t(ou,j) = cdbl(tableau(ou,j)) + cdbl(tableau(i,j))
    next
    t(i,0) = ""
  end if
next
redim resultat(d.count-1,2)
n = 0
for i = 0 to ubound(t)
  if t(i,0) <> "" then
    for j = 0 to ubound(tableau,2)
      resultat(n,j) t(i,j) :  resultat(n,j) t(i,j) :  resultat(n,j) = t(i,j)
    next
    n = n + 1
  end if
next




________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

serhoe · Answer

Je me suis trompé dans mon résultat, ça me donne :

cle1 6 2 
cle2 27 43 
cle3 5 9

Merci :)

cs_MPi · Answer

Bonjour,

J'irais un peu comme ceci.
Mes index de tableaux commencent à 1 parce que je les charge sous Excel. À modifier selon tes besoins.

L'idée est de boucler le même tableau avec 2 variables, additionner les quantités s'il y a lieu, vérifier si la clef n'est pas déjà inscrite et inscrire le résultat dans l'autre tableau.


    Idx = 1
    For I = 1 To UBound(Tab3) - 1
        'additionne les valeurs
        Val1 0: Val2 0
        For J = I To UBound(Tab3)
            If Tab3(I, 1) = Tab3(J, 1) Then
                Val1 = Val1 + Tab3(J, 2)
                Val2 = Val2 + Tab3(J, 3)
            End If
        Next
        
        'Remplir le tableau de résultat si la clef n'a pas déjà été copiée
        If Not IsInTableau(Tab3(I, 1), Tab4) Then
            Tab4(Idx, 1) = Tab3(I, 1)
            Tab4(Idx, 2) = Tab3(I, 2)
            Tab4(Idx, 3) = Tab3(I, 3)
            Idx = Idx + 1
        End If
    Next

'Vérifie si la clef est déjà copiée
Function IsInTableau(Clef As Variant, Tableau As Variant) As Boolean
    Dim I As Long
    
    For I = 1 To UBound(Tableau)
        If Clef = Tableau(I, 1) Then
            IsInTableau = True
            Exit For
        End If
    Next
End Function

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

ucfoutu · Answer

Bonjour,
Je "sens" venir la surprise si, comme il ne le dit pas et comme ne le laisse pas du tout penser la section dans laquelle il a ouvert cette discussion, serhoe développe finalement sous vbscript et non sous VB6.
Car si sous vbscript, je "vois" venir une concaténation (y compris avec le code de MPi, que je salue) et non l'addition qu'il attend. Ce que corrobore d'ailleurs sa phrase :
Il ne les additionne pas, mais les mets les uns après les autres...

Voilà, une fois de plus, la preuve manifeste des erreurs et pertes de temps que génèrent les ouvertures de discussions dans la section inappropriée. 
Bref ...

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Bon...
Je viens de mettre en route un portable sur lequel VBS n'est pas inhibé.
On réfléchit ===>> Le tableau/résultat ne doit donc pas avoir de doublons en colonne 0, ce qui veut dire, si l'on ne veut pas reboucler à chaque fois sur le tableau à traiter (lourd et ralentisseur), qu'il va nous falloir traiter via une collection ou via un dictionnaire. Mais voilà : VBS ne permet pas de créer une collection (oh !). Il nous reste donc le dictionnaire....
La difficulté (moindre) est que l'on voit bien quelle sera la clef, mais moins bien comment y mettre deux items (puisque deux valeurs).
L'autre difficulté sera que ce bourricot de vbs va tout interpréter comme des strings si on ne le corrige pas, avec, donc, des concaténations indues !
Je bois mon café et m'y mets puis reviens.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Voilà à quoi je parviens en premier jus "bâclé" (je "tâtonne" comme je peux avec VBS, que je connais vraiment très mal)
dim tableau(3,2), resultat(),d,i,toto,n1,n2,a,b
Set d = CreateObject("Scripting.Dictionary") 
For I = 0 To UBound(tableau)
  if not d.Exists(tableau(i,0)) then
    d.add tableau(i,0),tableau(i,1) & chr(1) & tableau(i,2)
  else
    toto = d.item(tableau(i,0))
    n1 clng(split(toto,chr(1))(0)) : n2 clng(split(toto,chr(1))(1))
    d.item(tableau(i,0)) = n1 + tableau(i,1) & chr(1) & n2 + tableau(i,2)
  end if
next     
a d.Keys : b d.items
redim resultat(d.count-1,2)
For i = 0 To d.Count -1
  toto = b(i)
  n1 clng(split(toto,chr(1))(0)) : n2 clng(split(toto,chr(1))(1))
  resultat(i,0) a(I) :  resultat(i,1) n1:  resultat(i,2) = n2
Next 

observations : 
1) je suis parti sur la base de ton exemple (valeurs entières). Si tu as des valeurs décimales, je modifierai en conséquence (mais tu devras me dire quel est le séparateur décimales)
2) le tableau resultat est celui résultant de l'exploitation souhaitée du tabeleau de départ (tableau tableau)
3) je "sens" (j'ai déjà une autre idée) qu'il y a encore mieux à faire.
Je ne me mettrai à cette tentative de "plus mieux" qu'après t'avoir entendu sur ce premier "jus" 
Bon dimanche
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Enlève tableau(3,2) de la ligne :
dim tableau(3,2), resultat(),d,i,toto,n1,n2,a,b

n'était là que pour mon essai. Toi, tu as déjà ton tableau de départ.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

serhoe · Answer

Merci de ton aide ucfoutu.

Pour les doublons j'avais commencé par faire une boucle qui parcourt dans mon premier tableau (avec les doublons) et met les clés dans un tableau temporaire. Si elles n'ont pas été déjà écrites dedans, il les écrit, sinon il passe à la suivante.

Puis pour 2000 lignes ça mettait 20 secondes, et sur un forum on m'a justement donné l'idée d'utiliser un dico, et grâce à ça, ça met plus que 2sec (inclu l'addition des valeurs).

Concernant les valeurs, oui j'en ai en décimales, et même négatives comme : -2,78. Tu sous entends quoi par séparateur ? la virgule ? si c'est le cas c'est bien la virgule.

Malheureusement je n'ai pas mon pc de travail avec moi, donc je verrai ça demain :)

ucfoutu · Answer

Malheureusement je n'ai pas mon pc de travail avec moi, donc je verrai ça demain :)

hé bien ===>>> nous attendrons donc demain 

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Et (important) : confirme-moi que tu ne développes pas en VB6, selon la présente section :
 Forum > Visual Basic 6
mais bel en bien, sous VBScript, comme me le laisse supposer/deviner le fait que tu obtiens une concaténation et non une addition.
Car la solution VBScript n'est pas du tout la même que celle que serait la solution VB6 !

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

serhoe · Answer

Je confirme que c'est bien du VBScript ;)

ucfoutu · Answer

Je confirme que c'est bien du VBScript 

Bon ... Prends dorénavant soin d'ouvrir ces discussion VBScript dans la section appropriée (Langages dérivés > VBScript. Tu vois bien (tyu en as la preuve avec cette discussion) que les choses ne sont pas les mêmes selon que VB6 et VBScript. C'est donc important. 
Tu m'as précisé que ton séparateur décimal est la virgule, ce qui me conduit à deviner (tu n'en avais pas parlé) que ton tableau originel est :
- soit alimenté par code en valeurs de type string
- soit dressé par code par exploitation d'un fichier texte. Mon petit doigt me dit que cette seconde hypothèse est la plus probable.

Mon épouse veut que je cesse de squatter son portable (seule machine où je peux tester VBS, absent de mon PC, comme dit plus haut).
Je me suis donc dépêché de faire un second "jus". Celui-ci est plus gourmand en lignes de code, mais plus rapide en exécution puisque j'y évite le traitement de chaînes de caractères (les splits du précédent "jus"). Je te conseille donc ce "jus" là.

Les faiblesses de vbscript m'ont obligé à une boucle de plus, mais elle est moins gourmande que des splits en boucle. 

dim d,i,t, resultat
t = tableau
Set d = CreateObject("Scripting.Dictionary") 
For I = 0 To UBound(tableau)
  'a d.Keys : b d.items
  if not d.Exists(t(i,0)) then
    d.add tableau(i,0),i
    t(i,1) = tableau(i,1)
    t(i,2) = tableau(i,2)
   else
    ou = d(t(i,0))
    t(ou,1) = cdbl(tableau(ou,1)) + cdbl(tableau(i,1))
    t(ou,2) = cdbl(tableau(ou,2)) + cdbl(tableau(i,2))
    t(i,0) = ""
  end if
next
redim resultat(d.count-1,2)
n = 0
for i = 0 to ubound(t)
  if t(i,0) <> "" then
    resultat(n,0) t(i,0) :  resultat(n,1) t(i,1) :  resultat(n,2) = t(i,2)
    n = n + 1
  end if
next
Résultat dans le tableau resultat
Dis-moi.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

et bien sur (oublié) ===>> corrige ===>>
[u]t(i,1) = tableau(i,1)
    t(i,2) = tableau(i,2)
/u
=>>
for j = 1 to ubound(tableau,2)
  t(i,j) = tableau(i,j)
next

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

stalex94 · Answer

Const ForReading = 1, ForWriting = 2 
Dim oFso, f
Set oFso = CreateObject("Scripting.FileSystemObject")
Set f = oFso.OpenTextFile("C:\Users\Monique\Downloads\Fichier à importer (1).csv", ForReading)
ln=-1
cl=0
 
while Not f.AtEndOfStream '1ère itération pour définir les limites du tableau
  ln=ln+1 'définition indice lignes
  Tab=Split(f.ReadLine,";")
  If cl < UBound(Tab) Then cl = UBound(Tab) 
Wend
f.Close
'MsgBox "indice lignes : " & ln+1 & "indice colonnes :" & cl+1
 
Dim Tab2()
ReDim Tab2(ln,cl)
Set f = oFso.OpenTextFile("C:\Users\Monique\Downloads\Fichier à importer (1).csv", ForReading)
i=0
while Not f.AtEndOfStream ' 2ème itération pour remplir le tableau Tab2
  Tab = Split(f.ReadLine,";")
  For j = 0 to UBound(Tab)
    Tab2(i,j) = Tab(j)
  Next
  i=i+1
Wend
f.Close

Dim Tab3()
ReDim Tab3(ln-1,cl)

For i=1 to UBound(Tab2,1) ' copie tout de tab2 à tab 3 sauf 1ere ligne marche
For j=0 to Ubound(Tab2,2)'oui		
Tab3(i-1,j)=Tab2(i,j)'oui
Next 
Next

For i=0 to UBound(Tab3,1) ' on copie dans tab3 les clés dans la première colonne de chaque ligne
For j=0 to Ubound(Tab3,2)
Tab3(i,0)=Tab3(i,3)+Tab3(i,5)+Tab3(i,6)+Tab3(i,9)
Next
Next 

For i=0 to Ubound(Tab3,1) ' on décale tous les mois vers la gauche
For j=1 to Ubound(Tab3,2)-20
Tab3(i,j)=Tab3(i,j+20)
Next
Next

Dim fsot, ft   
Set fsot = CreateObject("Scripting.FileSystemObject")
Set ft = fsot.OpenTextFile("C:\Users\Monique\Downloads\lololololololo.txt", 2,true)

Set objKeysDictionnary = CreateObject("Scripting.Dictionary") 'Création du dictionnaire contenant les clés
objKeysDictionnary.CompareMode = 1 'Mode de comparaison : texte
For i=0 to Ubound(Tab3,1) ' Pour chaque occurence du tableau Tab3
If objKeysDictionnary.Exists(Tab3(i,0)) Then
objKeysDictionnary.Item(Tab3(i,0)) = objKeysDictionnary.Item(Tab3(i,0)) + Tab3(i,1) 'Si la clé a déjà été trouvée, ajout des valeurs
Else
objKeysDictionnary.Add Tab3(i,0), Tab3(i,1) 'Sinon ajout de la clé au dictionnaire
End If
Next

i=0

For Each strKey In objKeysDictionnary.Keys 'Pour chaque clé contenue dans le dictionnaire
i=i+1
Next

Dim Tab4()
ReDim Tab4(i-1,13)

i=0

For Each strKey In objKeysDictionnary.Keys 'Pour chaque clé contenue dans le dictionnaire
Tab4(i,0)=strKey
i=i+1
Next

For i=0 to Ubound(Tab3,1)
For j=0 to Ubound(Tab4,1)
If Tab4(j,0)=Tab3(i,0) Then
Tab4(j,1)=Tab4(j,1)+Tab3(i,1)
Tab4(j,2)=Tab4(j,2)+Tab3(i,2)
Tab4(j,3)=Tab4(j,3)+Tab3(i,3)
Tab4(j,4)=Tab4(j,4)+Tab3(i,4)
Tab4(j,5)=Tab4(j,5)+Tab3(i,5)
Tab4(j,6)=Tab4(j,6)+Tab3(i,6)
Tab4(j,7)=Tab4(j,7)+Tab3(i,7)
Tab4(j,8)=Tab4(j,8)+Tab3(i,8)
Tab4(j,9)=Tab4(j,9)+Tab3(i,9)
Tab4(j,10)=Tab4(j,10)+Tab3(i,10)
Tab4(j,11)=Tab4(j,11)+Tab3(i,11)
Tab4(j,12)=Tab4(j,12)+Tab3(i,12)
End If
Next
Next	

m=0
Redim Preserve Tab4(Ubound(Tab4,1),13) ' pour le bon nombre de colonnes
For i=0 to UBound(Tab4,1) ' copie de tab3 dans le fichier et marche
For j=0 to UBound(Tab4,2)
If m < UBound(Tab4,2) Then 
ft.write(Tab4(i,j) & "	")
m=m+1
Else
ft.write(Tab4(i,j) & vbcrlf)
m=0
End If
Next
Next

C'est tout mon code.
Le fichier CSV possède 34 colonnes. La clé est composée du contenu de 4 colonnes (3, 5,6 et 9) de Tab3, il possède aussi 12/13 colonnes, une pour chaque mois de l'année (janvier...) contenant des valeurs (peut = 0).
Le reste sont des choses dont je n'ai pas besoin.

Du coup comme tu peux le voir dans un premier temps, j'importe tout ce qu'il y a dans le fichier CSV dans un tableau (Tab2) je copie tout de Tab2 dans Tab3 en enlevant la première ligne de tab2 (qui sont les titres de chaque colonne). Dans Tab4 je mets toutes les clés uniques.

Et pour finir je copie les valeurs de chaque mois de Tab3 dans Tab4 (et c'est là que ça concatène).

J'essaie ce que tu m'as donné :)

stalex94 · Answer

Du coup je sais pas où caser ton code

ucfoutu · Answer

dis-donc voir, serhoe, tu es finalement qui, dans cette affaire ? ==>>
serhoe ? stalex94 ?
Les deux ? ru as deux comptes ?
Réponds donc d'abord à cette question !



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

stalex94 · Answer

Oui je suis les deux. Je m'étais inscrit avec un premier compte (stalex94) y'a 1 an et demi et j'ai déserté le forum.
Du coup quand je suis revenu début juin, j'avais complètement oublié que j'avais déjà un compte et j'en ai donc créé un second. 
Mea culpa

ucfoutu · Answer

Moi, c'est à serhoe (le demandeur officiel), que je vais répondre. Et je refuserai de répondre à tout nouveau message de l' "autre" !
Mon code intervient (ta seule demande) pour traiter un tableau tableau (c'est ton tableau tab3, apparemment) et dresser le tableau resultat (ton tableau tab4, apparemment)
tout le reste (comment tu obtiens tab3 et ce que tu fais de tab4) est hors sujet.
Je note simplement que la manière dont tu fais ton tab3 à partir de ton fichier est lourde et devrais être améliorée. Mais c'est là (bis repetita) une autre affaire. Si tu veux également régler celle-là ===>> une autre discussion relative à ce SEUL point. 

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

serhoe · Answer

Désolé ucfoutu... c'est bien moi stalex94.

Oui je fais 3 boucles for pour remplir correctement Tab3. Je pense que ça peut être optimisé en n'en faisant qu'une seule, et je le ferai quand j'aurai fini mon programme dans son intégralité, ce qui est loin d'être fini 

Oui oui, la seule chose que je demande ici, c'est de trouver de l'aide pour empêcher la concaténation afin de pouvoir additionner deux cellules. A partir du code que j'ai donné avec mon compte stalex94, peux tu m'aider à intégré ton code dedans ? Je t'en serai très reconnaissant

ucfoutu · Answer

peux tu m'aider à intégré ton code dedans ? Je t'en serai très reconnaissant 

ben .?.. je te l'ai dit, non ?
Mon code est à substituer à tout ce qui commence, dans le tien, par ta ligne :
Set objKeysDictionnary = CreateObject("Scripting.Dictionary") 'Création du dictionnaire contenant les clés
et qui se termine par ta ligne :
Redim Preserve Tab4(Ubound(Tab4,1),13) ' pour le bon nombre de colonnes
en remplaçant tableau par tab3 et resultat par tab4

et tab4 est ce que tu dois exploiter pour écrire ton fichier !
regarde donc ce que contient tab4 (tu devrais comprendre).
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

ucfoutu · Answer

Je te conseille vivement d'ouvrir une autre discussion relative uniquement à la manière la plus agile de dresser ton tableau tab3 à partir de ton fichier csv.
En montrant 2 ou 3 lignes de ce fichier csv
Et nous reviendrons ici lorsque cet aspect-là aura été traité.
Autre discussion à ce seul propos, donc 


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

serhoe · Answer

Merci pour ton aide  ucfoutu, encore un ch'ti problème :

Const ForReading 1, ForWriting 2 
Dim oFso, f
Set oFso = CreateObject("Scripting.FileSystemObject")
Set f = oFso.OpenTextFile("C:\Users\Monique\Downloads\Fichier à importer (1).csv", ForReading)
ln=-1
cl=0
 
while Not f.AtEndOfStream '1ère itération pour définir les limites du tableau
  ln=ln+1 'définition indice lignes
  Tab=Split(f.ReadLine,";")
  If cl < UBound(Tab) Then cl = UBound(Tab) 
Wend
f.Close
'MsgBox "indice lignes : " & ln+1 & "indice colonnes :" & cl+1
 
Dim Tab2()
ReDim Tab2(ln,cl)
Set f = oFso.OpenTextFile("C:\Users\Monique\Downloads\Fichier à importer (1).csv", ForReading)
i=0
while Not f.AtEndOfStream ' 2ème itération pour remplir le tableau Tab2
  Tab = Split(f.ReadLine,";")
  For j = 0 to UBound(Tab)
    Tab2(i,j) = Tab(j)
  Next
  i=i+1
Wend
f.Close

Dim Tab3()
ReDim Tab3(ln-1,cl)

For i=1 to UBound(Tab2,1) ' copie tout de tab2 à tab 3 sauf 1ere ligne marche
For j=0 to Ubound(Tab2,2)'oui		
Tab3(i-1,j)=Tab2(i,j)'oui
Next 
Next

For i=0 to UBound(Tab3,1) ' on copie dans tab3 les clés dans la première colonne de chaque ligne
For j=0 to Ubound(Tab3,2)
Tab3(i,0)=Tab3(i,3)+Tab3(i,5)+Tab3(i,6)+Tab3(i,9)
Next
Next 

For i=0 to Ubound(Tab3,1) ' on décale tous les mois vers la gauche
For j=1 to Ubound(Tab3,2)-20
Tab3(i,j)=Tab3(i,j+20)
Next
Next

Dim fsot, ft   
Set fsot = CreateObject("Scripting.FileSystemObject")
Set ft = fsot.OpenTextFile("C:\Users\Monique\Downloads\lololololololo.txt", 2,true)

dim d,i,t, Tab4
t = Tab3
Set d = CreateObject("Scripting.Dictionary") 
For I = 0 To UBound(Tab3)
  'a d.Keys : b d.items
  if not d.Exists(t(i,0)) then
    d.add Tab3(i,0),i
    t(i,1) = Tab3(i,1)
    t(i,2) = Tab3(i,2)
t(i,3) = Tab3(i,3)
    t(i,4) = Tab3(i,4)
t(i,5) = Tab3(i,5)
    t(i,6) = Tab3(i,6)
t(i,7) = Tab3(i,7)
    t(i,8) = Tab3(i,8)
t(i,9) = Tab3(i,9)
    t(i,10) = Tab3(i,10)
t(i,11) = Tab3(i,11)
    t(i,12) = Tab3(i,12)
   else
    ou = d(t(i,0))
    t(ou,1) = cdbl(Tab3(ou,1)) + cdbl(Tab3(i,1))
    t(ou,2) = cdbl(Tab3(ou,2)) + cdbl(Tab3(i,2))
t(ou,3) = cdbl(Tab3(ou,3)) + cdbl(Tab3(i,3))
t(ou,4) = cdbl(Tab3(ou,4)) + cdbl(Tab3(i,4))
t(ou,5) = cdbl(Tab3(ou,5)) + cdbl(Tab3(i,5))
t(ou,6) = cdbl(Tab3(ou,6)) + cdbl(Tab3(i,6))
t(ou,7) = cdbl(Tab3(ou,7)) + cdbl(Tab3(i,7))
t(ou,8) = cdbl(Tab3(ou,8)) + cdbl(Tab3(i,8))
t(ou,9) = cdbl(Tab3(ou,9)) + cdbl(Tab3(i,9))
t(ou,10) = cdbl(Tab3(ou,10)) + cdbl(Tab3(i,10))
t(ou,11) = cdbl(Tab3(ou,11)) + cdbl(Tab3(i,11))
t(ou,12) = cdbl(Tab3(ou,12)) + cdbl(Tab3(i,12))
    t(i,0) = ""
  end if
next
redim Tab4(d.count-1,13)
n = 0
for i = 0 to ubound(t)
  if t(i,0) <> "" then
    Tab4(n,0) t(i,0) :  Tab4(n,1) t(i,1) :  Tab4(n,2) = t(i,2) : Tab4(n,3) = t(i,3) : Tab4(n,4) = t(i,4) : Tab4(n,5) = t(i,5) : Tab4(n,6) = t(i,6) : Tab4(n,7) = t(i,7) : Tab4(n,8) = t(i,8) : Tab4(n,9) = t(i,9) : Tab4(n,10) = t(i,10) : Tab4(n,11) = t(i,11) : Tab4(n,12) = t(i,12)
    n = n + 1
  end if
next
For i=0 to UBound(Tab4,1) ' copie de tab3 dans le fichier et marche
For j=0 to UBound(Tab4,2)
If m < UBound(Tab4,2) Then 
ft.write(Tab4(i,j) & "	")
m=m+1
Else
ft.write(Tab4(i,j) & vbcrlf)
m=0
End If
Next
Next

Si j'ai trois doublons, exemple :

cle1 2
cle1 3
cle1 8

ça m'affichera :

cle1 10

Il ne prend en compte que le premier et dernier :(

ucfoutu · Answer

Je ne serai à nouveau avec toi, serhoe, que lorsque tu auras su sérier les deux problèmes :
- 1) pour faire ton tableau tab3 à partir de ton csv (une discussion)
- 2) l'autre pour traiter ton tab3 (la présente discussion).


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

serhoe · Answer

Tab3 fonctionne ucfoutu ! Il est pas super optimisé mais il fonctionne.

Mon problème ici relève du traitement de Tab3 en Tab4 et non pas à partir du CSV

ucfoutu · Answer

Mon problème ici relève du traitement de Tab3 en Tab4 et non pas à partir du CSV

Hé non !
Car si tab3 n'est pas dressé correctement (et il me semble que tu t'es évertué à l'inverser inutilement), tout plante ! 
Tu en veux la démo ? ===>> voilà ===>> je pars de l'exemple répondant à ce que tu as exprimé dans ta demande (hein ...) ===>>
dim tableau(3,2),d,i,t,j,n, resultat
' je "dresse un tableau tab3 (celui de travail) correctement
tableau(0,0) = "clef1"
tableau(0,1) = "6,2"
tableau(0,2) = "2"
tableau(1,0) = "clef2"
tableau(1,1) = "2"
tableau(1,2) = "-4,35"
tableau(2,0) = "clef3"
tableau(2,1) = "5"
tableau(2,2) = "9"
tableau(3,0) = "clef2"
tableau(3,1) = "7"
tableau(3,2) = "3"
t = tableau
Set d = CreateObject("Scripting.Dictionary") 
For I = 0 To UBound(tableau)
  'a d.Keys : b d.items
  if not d.Exists(t(i,0)) then
    d.add tableau(i,0),i
    'for j = 1 to ubound(tableau,2)
    '   t(i,j) = tableau(i,j)
    'next

   else
    ou = d(t(i,0))
    for j = 1 to ubound(tableau,2)
       t(ou,j) = cdbl(tableau(ou,j)) + cdbl(tableau(i,j))
    next
    t(i,0) = ""
  end if
next
redim resultat(d.count-1,2)
n = 0
for i = 0 to ubound(t)
  if t(i,0) <> "" then
    for j = 0 to ubound(tableau,2)
      resultat(n,j) t(i,j) :  resultat(n,j) t(i,j) :  resultat(n,j) = t(i,j)
    next
    n = n + 1
  end if
next

' et je fais maintenant la preuve ====>>
for i = 0 to ubound(resultat)
 msgbox  resultat(i,0)  & "  " &   resultat(i,1) & "  " &   resultat(i,2)
next
alors ? 
Maintenant : où tu continues à t'obstiner (et ce sera seul), ou tu réagis comme suggéré (et je serai là) ===>> à toi de voir (on en est à la 3ème page d'une discussion qui n'aurait jamais du excéder UNE page !)!

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

serhoe · Answer

Celui ci marche. Car il n'y a que 2 clés identiques au maximum.
De mon côté ça marche aussi avec mon code. Ce qui ne marche pas c'est si t'as au moins 3 clés identiques, exemple :

cle1  2  3
cle1  9  -5
cle1  -3  8 

Dans ce cas ça me donnera :

cle1  -1  11

Si j'ai uniquement 

cle1  2  3
cle1  9  -5

Ca me donnera :

cle1 11 -2

Tu comprends ? Je m'obstine pas je cherche juste à comprendre

serhoe · Answer

Concernant mon Tab3, il s'affiche exactement comme je le souhaite 
Bon nombre de lignes et de colonnes !

ucfoutu · Answer

ah ! tu peux avoir plus de un seul doublon ? =)== Modif simple et élémentaire ===>>

exemple
dim tableau(3,2),d,i,t,j,n, resultat
tableau(0,0) = "clef1"
tableau(0,1) = "2"
tableau(0,2) = "3"
tableau(1,0) = "clef2"
tableau(1,1) = "2"
tableau(1,2) = "-4,35"
tableau(2,0) = "clef1"
tableau(2,1) = "9"
tableau(2,2) = "-5"
tableau(3,0) = "clef1"
tableau(3,1) = "-3"
tableau(3,2) = "8"
t = tableau
Set d = CreateObject("Scripting.Dictionary") 
For I = 0 To UBound(tableau)
  'a d.Keys : b d.items
  if not d.Exists(t(i,0)) then
    d.add tableau(i,0),i
  else
    ou = d(t(i,0))
    for j = 1 to ubound(tableau,2)
       t(ou,j) = cdbl(t(ou,j)) + cdbl(t(i,j))
    next
    t(i,0) = ""
  end if
next
redim resultat(d.count-1,2)
n = 0
for i = 0 to ubound(t)
  if t(i,0) <> "" then
    for j = 0 to ubound(tableau,2)
      resultat(n,j) t(i,j) :  resultat(n,j) t(i,j) :  resultat(n,j) = t(i,j)
    next
    n = n + 1
  end if
next

'preuve
for i = 0 to ubound(resultat)
 msgbox resultat(i,0)  & "  " &   resultat(i,1) & "  " &   resultat(i,2)
next


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

serhoe · Answer

Du coup je suis reparti de mon code, j'ai ajouté les cdbl(expression) que tu avais écrit dans le tien et ça marche comme sur des roulettes.
Dommage ton code était mieux écrit et plus rapide que le mien :( (de 1/2 secondes pour 2200 lignes).

Tab4(j,1)=cdbl(Tab4(j,1))+cdbl(Tab3(i,1))

J'ai maintenant un tout dernier petit problème quelques fois j'ai des problèmes de style :
72.099999999 pour 72.1.

Je poste ça dans un autre sujet, merci ucfoutu, sympa de ta part

serhoe · Answer

Const ForReading = 1, ForWriting = 2 
Dim oFso, f
Set oFso = CreateObject("Scripting.FileSystemObject")
Set f = oFso.OpenTextFile("C:\Users\Monique\Downloads\Fichier à importer (1).csv", ForReading)
ln=-1
cl=0
 
while Not f.AtEndOfStream '1ère itération pour définir les limites du tableau
  ln=ln+1 'définition indice lignes
  Tab=Split(f.ReadLine,";")
  If cl < UBound(Tab) Then cl = UBound(Tab) 
Wend
f.Close
'MsgBox "indice lignes : " & ln+1 & "indice colonnes :" & cl+1
 
Dim Tab2()
ReDim Tab2(ln,cl)
Set f = oFso.OpenTextFile("C:\Users\Monique\Downloads\Fichier à importer (1).csv", ForReading)
i=0
while Not f.AtEndOfStream ' 2ème itération pour remplir le tableau Tab2
  Tab = Split(f.ReadLine,";")
  For j = 0 to UBound(Tab)
    Tab2(i,j) = Tab(j)
  Next
  i=i+1
Wend
f.Close

Dim Tab3()
ReDim Tab3(ln-1,cl)

For i=1 to UBound(Tab2,1) ' copie tout de tab2 à tab 3 sauf 1ere ligne marche
For j=0 to Ubound(Tab2,2)'oui		
Tab3(i-1,j)=Tab2(i,j)'oui
Next 
Next

For i=0 to UBound(Tab3,1) ' on copie dans tab3 les clés dans la première colonne de chaque ligne
For j=0 to Ubound(Tab3,2)
Tab3(i,0)=Tab3(i,3)+Tab3(i,5)+Tab3(i,6)+Tab3(i,9)
Next
Next 

For i=0 to Ubound(Tab3,1) ' on décale tous les mois vers la gauche
For j=1 to Ubound(Tab3,2)-20
Tab3(i,j)=Tab3(i,j+20)
Next
Next

Dim fsot, ft   
Set fsot = CreateObject("Scripting.FileSystemObject")
Set ft = fsot.OpenTextFile("C:\Users\Monique\Downloads\lololololololo.txt", 2,true)

dim d,i,t,j,n, Tab4
t = Tab3
Set d = CreateObject("Scripting.Dictionary") 
For I = 0 To UBound(Tab3)
  if not d.Exists(t(i,0)) then
    d.add Tab3(i,0),i
    t(i,1) = Tab3(i,1)
    t(i,2) = Tab3(i,2)
   else
    ou = d(t(i,0))
   
    t(ou,1) = cdbl(t(ou,1)) + cdbl(t(i,1))
    t(ou,2) = cdbl(t(ou,2)) + cdbl(t(i,2))
t(ou,3) = cdbl(t(ou,3)) + cdbl(t(i,3))
t(ou,4) = cdbl(t(ou,4)) + cdbl(t(i,4))
t(ou,5) = cdbl(t(ou,5)) + cdbl(t(i,5))
t(ou,6) = cdbl(t(ou,6)) + cdbl(t(i,6))
t(ou,7) = cdbl(t(ou,7)) + cdbl(t(i,7))
t(ou,8) = cdbl(t(ou,8)) + cdbl(t(i,8))
t(ou,9) = cdbl(t(ou,9)) + cdbl(t(i,9))
t(ou,10) = cdbl(t(ou,10)) + cdbl(t(i,10))
t(ou,11) = cdbl(t(ou,11)) + cdbl(t(i,11))
t(ou,12) = cdbl(t(ou,12)) + cdbl(t(i,12))

    t(i,0) = ""
  end if
next
redim Tab4(d.count-1,2)
n = 0
for i = 0 to ubound(t)
  if t(i,0) <> "" then
    for j = 0 to ubound(Tab3,2)
      Tab4(n,j) t(i,j) :  Tab4(n,j) t(i,j) :  Tab4(n,j) = t(i,j)
    next
    n = n + 1
  end if
next
For i=0 to UBound(Tab4,1) ' copie de tab3 dans le fichier et marche
For j=0 to UBound(Tab4,2)
If m < UBound(Tab4,2) Then 
ft.write(Tab4(i,j) & "	")
m=m+1
Else
ft.write(Tab4(i,j) & vbcrlf)
m=0
End If
Next
Next

J'ai une erreur avec ton code ucfoutu :
"Ligne 85 :Indice en dehors de la place:3"

Cette ligne correspond à la for :

 for j = 0 to ubound(Tab3,2)
      Tab4(n,j) t(i,j) :  Tab4(n,j) t(i,j) :  Tab4(n,j) = t(i,j)
    next

[VB6 -> VBS]addition

30 réponses

Votre réponse

Discussions similaires