Fonction find et sous totaux
Bonjour,
Après des recherches sur ce site, d'autres et dans mon vieux cerveau ( la programmation étant dans une autre vie,
En pj le fichier constitué d'un fichier de données (transit) et d'un fichier destinataire "service fait"
- il y a plusieurs articles pour une demande d'achat
- mon but est de créer un fichier service fait pour chaque DA ( Total 1,Total 2,total 3,etc..) où je récupérerai des données du tableau pour les envoyer dans un fichier via une autre feuille.
Après un tris avec des sous-totaux : ok
- je piste les cellules 'Total 1,2,..." : PROBLEME
- je récupère les données à partir de cette cellule: OK
- je copie les données dans la nouvelle feuille: ok
- je renomme et sauvegarde le fichier : ok
- le nombre de sous total peut changer à tout moment
- j'ai essayé findnext, et plein d'autres fonctions et je me heurt au même problème.
- j'ai essayé d'insérer l'option like mais bon ça a bien planté ( ça doit être une voie intéressante )
- j'ai essayé la fonction cells.find mais je n'obtiens que le 1er total mais qui fonctionne très bien
j 'aimerai bien mettre dans l'argument what de la fonction cells.find le compteur pour effectuer
les recherches au fur et à mesure. une boucle
je suis preneur d'une autre méthode si celle_là n'existe pas.
En vous remerciant pour votre aide
Bonjour Fred.
Je te donne une autre méthode, je te laisse la création des différentes feuilles. Ici j'alimente constamment la même feuille.
Test en pas-à-pas (F8) depuis VB.
Option Explicit
Sub service_fait()
Dim a(), d As Object, i%, j%, f1 As Worksheet, f2 As Worksheet, k, temp
'Enregistrement des feuilles dans un objet.
Set f1 = ThisWorkbook.Sheets(1): Set f2 = ThisWorkbook.Sheets(2)
'Enregistrement du transit dans un tableau virtuel.
a = f1.[a1].CurrentRegion.Value
'Création du dictionnaire.
Set d = CreateObject("scripting.dictionary")
'Boucle du tableau pour alimenter le dictionnaire.
'Clef = n° de bon "," n° sillage.
'Item = montant TTC
For i = LBound(a) + 1 To UBound(a)
d(a(i, 10) & "," & a(i, 9)) = d(a(i, 10) & "," & a(i, 9)) + a(i, 13)
Next i
'Recopie dans la feuille Service.
'k étant la clef.
For Each k In d.keys
temp = Split(k, ",")
f2.[a7].Value = temp(0)
f2.[c7].Value = temp(1)
f2.[d14].Value = d(k)
Next k
End SubBonjour
J'ai bien étudié le programme.
Effectivement les tableaux virtuels, j'ai pas voulu m'en approcher, mais c'est intéressant quand on a bq de données et plus rapide.
il fait bien l'itération . En couplant avec la création de feuille ça tombe nickel sur un de mes objectifs.
Toutefois le gros bug c'est que ça ne transmet pas la somme des montants contenu dans chaque Da
Da 1 = 100+100+100+100 par exemple
ça met une valeur inconnue du tableau ou une des valeurs de la première occurrence.
Par contre j'ai continué à travailler également sur le programme un peu plus lourd (j'ai testé la boucle pour scruter chaque cellule à la recherche de "total ", il me prend bien le 1er total mais pas les autres. (j'ai un peu avancé mais je pense que j'ai de la redondance lol. on verra plus tard pour le nettoyage). je cherche, je cherche.
donc 2 pistes :
- soit arriver à faire la somme des " tarif final TTC" pour chaque clef dans les tableaux virtuels; j'ai essayé de comprendre le positionnement pour la récupération de la bonne valeur ( là je bug, j'ai du rester au ba-ba de vba)
- soit arriver à attraper tous les "total" dans la version de base ( ce qui reviendrait à récupérer le nombre de total puis de le concaténer avec la chaine de caractère "total " pour effectuer la fonction cell.find avec comme argument "what" la nouvelle chaine de caractère. ( un peu méga beaucoup lourd). Vais bien trouver une fonction dans l'arsenal vba.
Je suis preneur de tout.
Merci encore pour votre aide
Bonjour
J'ai bien étudié le programme.
Effectivement les tableaux virtuels, j'ai pas voulu m'en approcher, mais c'est intéressant quand on a bq de données et plus rapide.
il fait bien l'itération . En couplant avec la création de feuille ça tombe nickel sur un de mes objectifs.
Toutefois le gros bug c'est que ça ne transmet pas la somme des montants contenu dans chaque Da
Da 1 = 100+100+100+100 par exemple
ça met une valeur inconnue du tableau ou une des valeurs de la première occurrence.
Il y avait juste une erreur dans ma proposition, j'ai additionné la colonne 13 soit majoration nuit au lieu de la colonne 12.
Remplacer le 13 par un 12 et ça fonctionnera (ça m'apprendra à ne pas vérifier ..)
d(a(i, 10) & "," & a(i, 9)) = d(a(i, 10) & "," & a(i, 9)) + a(i, 13)bonjour
Après vérification jai saisi cette ligne de commande.
j'ai modifié la colonne qui se trouve être la 14 ( j'ai focalisé sur la 11 lol) ( ce n'était pas le pb le plus important)
j'ai supprimé le "+1" du Lbound car :
- le premier enregistrement est bon mais du fait du "+1" qui existait dans la boucle, le programme oubliait la première ligne de" chaque DA suivante. En enlevant le "+1" il additionne correctement les lignes
For i = LBound(a) To UBound(a)
d(a(i, 10) & "," & a(i, 9)) = d(a(i, 10) & "," & a(i, 9)) + a(i, 14)
Par contre, cela entraine un mauvais positionnement de la variable "a" à l'origine. Celle-ci pointe dans la cellule de titre et donc fait apparaitre du texte au lieu du montant.
j'ai voulu rajouter le "+1" lors de "l'enregistrement du transit dans un tableau virtuel" mais bon, ça plante (lol). Je me suis dit on ne sait jamais
j'ai aussi essayé de pointer le tableau sur F1[a2] mais sans résultat
donc j'ai laissé comme ça et 'ai triché sur la création de feuille
je synchronise les feuilles et je supprime les feuilles da -1 et 0.
Les profs nous disait :"C'est pas bien il doit avoir une solution". Les techniciens ( moi et mes collègues) disent :" on peaufine et si avec ce réglage ça fonctionne, ben on laisse
Je ne suis plus en programmation temps réel, pour ce cas là , on n'est pas à une milliseconde
et après ce dernier réglage, je pense qu'on pourra clôturer le dossier.
Ci dessous le nouveau listing
Option Explicit
Sub service_fait()
Dim a(), d As Object, c%, i%, j%, f1 As Worksheet, f2 As Worksheet, k, temp
c = -2 'obligation sinon pas de synchronisation du nom des feuilles
'Enregistrement des feuilles dans un objet.
Set f1 = ThisWorkbook.Sheets(1): Set f2 = ThisWorkbook.Sheets(2)
'Enregistrement du transit dans un tableau virtuel.
a = f1.[a1].CurrentRegion.Value
'Création du dictionnaire.
Set d = CreateObject("scripting.dictionary")
'Boucle du tableau pour alimenter le dictionnaire.
'Clef = n° de bon "," n° sillage.
'Item = montant TTC
For i = LBound(a) To UBound(a)
d(a(i, 10) & "," & a(i, 9)) = d(a(i, 10) & "," & a(i, 9)) + a(i, 14)
Next i
'Recopie dans la feuille Service.
'k étant la clef.
For Each k In d.keys
Sheets("SERVICE FAIT").Copy After:=Sheets(Sheets.Count)
c = c + 1
ActiveSheet.Select
ActiveSheet.Name = "da " & c
temp = Split(k, ",")
f2.[a7].Value = temp(0)
f2.[c7].Value = temp(1)
f2.[d14].Value = d(k)
f2.[d14].NumberFormat = "#,##0.00" ' formate la case
Next k
'suppression des 2 feuilles inutiles
Application.DisplayAlerts = False
Sheets("Da -1").Delete
Sheets("Da 0").Delete
Application.DisplayAlerts = True
'fin suppression
End Sub
Bonjour Fred.
Je suppose que le fichier sur lequel tu travailles est différent que celui transmis.
Il ne faut pas supprimer le +1.
En effet, j'enregistre le tableau virtuel avec les titres comme tu l'as remarqué, le +1 permet de commencer la boucle après la ligne des titres.
Sur le fichier test les résultats sont cohérents avec ceux réalisés manuellement.
S'il y a des soucis avec ton fichier final, il faudrait voir directement dessus alors.
re
Je viens de revérifier,
Effectivement je retombe sur les bons chiffres ( avec c=-1). je devais être dans une autre colonne également. Une mauvaise lecture
j'ai transféré toute la procédure sur le fichier final , j'ai fait des ajustements mais sur d'autres points
[b]
En conclusion [/b]
le fichier fonctionne nickel
Merci beaucoup pour ton temps et cette solution
PS ( ce n'est qu'une partie du programme mais j'avance doucement)
Je laisse en pj le fichier si besoin est
Je clos le sujet
J'ai adapté ton fichier.
Il n'est pas utile d'avoir un "da 0".
Egalement essaye d'utiliser le Thisworkbook. Si tu lances la procédure avec un autre fichier actif, ça prendra ce fichier en compte.
Vais voir en mettant c=0
On ne sait jamais mais quand j’ai Testé au début ça n’a pas marché mais je verrai demain
Et je vais explorer l’autre piste
A suivre
Regarde le fichier transmis qui donne le même résultat que celui souhaité.
re
après avoir vu le code. effectivement il fallait remettre dans l'ordre
merci pour cette info, je prend note et vais l'utiliser de ce pas