Bonjour  
 
Je suis débutant en vba et je dois faire un petit programme
 
J'ai un petit probème avec une macro ...
J'ai un fichier dont le nombre de données varient ( et donc le nombre de lignes) mais les colonnes restent les mêmes ... j'ai 3 colonnes : les titres ( col 2) , les montants (col 10 ) , et les noms ( col 6 )  
 
J'aimerai un programme qui vienne lire tous les titres ... ( ici le seul titre démandé est x)  et qui viennent sommer les montants correspondant.
 
Mon probleme est que :  
 
je n'arrive pas à imposer a ma macro de commencer a sommer 5 lignes apres avoir sélectionner le titre sélectionné ( ici x ) et surtout ma macro ne s'arrete pas apres , elle continue a sommer les valeurs des titres suivants  
info suplémentaire : entre chaque montant il y a 1 blanc  
entre le dernier montant d'un titre , et le premier du suivant il y a 2 blanc ... donc j'aimerais des qu'il y a 2 blanc qu'elle s'arrête ...  
 
Voici la macro (qui ouvre le fichiercible  avec les titres ,les montant.. pour copier la somme dans le fichier ouvert)
 
 
 
Sub copier_sinistre()
 
 
Dim i As Integer
Dim last_line As Integer
Dim star_line As Integer
 
 
Workbooks.Open Filename:="D:\Documents and Settings\x7001\Bureau\2008Sinistres02062009.xls"
Workbooks("2008Sinistres02062009.xls" ).Worksheets("PREVIsin2008" ).Activate
 
 
Worksheets("PREVIsin2008" ).Select
 
 
last_line = Cells(65536, 10).End(xlUp).Row
start_line = 1
Dim tab1
Set tab1 = CreateObject("Scripting.Dictionary" )
old_cle = ""
For ligne = start_line To last_line
    If Cells(ligne, 2) = "" Then
        cle = old_cle
    Else
        cle = Cells(ligne, 2)
        old_cle = cle
    End If
   
    If Cells(ligne, 10) <> 0 Then
        If tab1.exists(cle) Then
            tmp = tab1(cle)
            tmp(0) = tmp(0) + Cells(ligne, 10) ' cumul des sommes
            tmp(1) = tmp(1) & " " & Cells(ligne, 6) ' cumul des noms
            tab1(cle) = tmp
        Else
            tab1(cle) = Array(Cells(ligne, 10), Cells(ligne, 6))
        End If
     
  MsgBox (Cells(ligne, 10))
        End If
Next
 
cle = "x"
tmp = tab1(cle)
 
Cells(1, 1) = tmp(0)
 
'Workbooks(1).Worksheets(1).Cells(1, 1) = tmp(0)
 
'Workbooks(1).Activate
'Cells(1, 1).ClearComments
'Cells(1, 1).Select
'Cells(1, 1).AddComment
'Cells(1, 1).Comment.Text Text:=tmp(1)
 
 
 
End Sub
 
 
 
merci de m'aider ...
cordialement

up please

up pls
 

Sub copier_sinistre() 
 
 
Dim i As Integer 
Dim last_line As Integer 
Dim star_line As Integer 
 
 
Workbooks.Open Filename:="D:\Documents and Settings\x7001\Bureau\2008Sinistres02062009.xls" 
Workbooks("2008Sinistres02062009.xls" ).Worksheets("PREVIsin2008" ).Activate 
 
 
Worksheets("PREVIsin2008" ).Select 
 
 
last_line = Cells(65536, 10).End(xlUp).Row 
start_line = 1 
Dim tab1 
Set tab1 = CreateObject("Scripting.Dictionary" ) 
old_cle = "" 
For ligne = start_line To last_line 
    If Cells(ligne, 2) = "" Then 
        cle = old_cle 
    Else 
        cle = Cells(ligne, 2) 
        old_cle = cle 
    End If 
    
    If Cells(ligne, 10) <> 0 Then 
        If tab1.exists(cle) Then 
            tmp = tab1(cle) 
            tmp(0) = tmp(0) + Cells(ligne, 10) ' cumul des sommes 
            tmp(1) = tmp(1) & " " & Cells(ligne, 6) ' cumul des noms 
            tab1(cle) = tmp 
        Else 
            tab1(cle) = Array(Cells(ligne, 10), Cells(ligne, 6)) 
        End If 
     
  MsgBox (Cells(ligne, 10)) 
        End If 
Next 
 
cle = "x" 
tmp = tab1(cle) 
 
Cells(1, 1) = tmp(0) 
 
Workbooks(1).Worksheets(1).Cells(1, 1) = tmp(0) 
 
Workbooks(1).Activate 
Cells(1, 1).ClearComments 
Cells(1, 1).Select 
Cells(1, 1).AddComment 
Cells(1, 1).Comment.Text Text:=tmp(1)

bonne idée de mettre de la couleur, ca donnait pas vraiment envie de lire ton premier post  
aurais tu un fichier exemple simplifié pour expliquer ton soucis?
peux-tu également précisé ton erreur?
au fait je te signale que tu fais des calculs avant d'avoir finit de compléter ton dictionnaire, je ne sais pas si c'est voulu mais à première vue c'est bizarre  

oui , peut tu me donner ton mail ...
Je suis un débutant alors introduire des clé dans le dico , je suis un perdu , perso , j'ai compris que l'on cré , un  tableau , dont on allé selectionner des mot clé .... merci de bien vouloir m'aider

je mets pas mon mail sur des sites publique désolé  
 
tien voila un script adapté rapidement, d'un de mes anciens script
voila comment j'initialise un dico bidon

' Defintion d'un dictionnaire bidon
Set objExcel = CreateObject("Excel.Application" )
objExcel.Workbooks.Open("chemin\monexcel.xls" ) 
Set feuille = objExcel.Workbooks(1).Worksheets(2)
' Initialisation du dictionnaire 
set dicocoef=CreateObject("Scripting.Dictionary" )
k=1
Do While (StrComp(feuille.Cells(k, 1).Value,"" )<>0)
    if StrComp(feuille.Cells(k, 5).Value,"" )<>0 then
        dicocoef.add feuille.Cells(k, 1).Value , feuille.Cells(k, 5).Value
    End if
    k=k+1
Loop

là en gros je parcours la première colonne, tant qu'elle est non vide je continue
Si la 5 eme colonne à une valeur je la rentre dans mon dico
Et c'est ensuite que j'utiliserais mon dico.
 
Mais j'ai peut être aussi pas suivi comment toi tu as besoin de t'en servir.
C'est pour ça qu'une explication un peu plus claire serai bien sur ton besoin .
 
Ce que j'ai compris:
nombre de colonne fixe, nombre de ligne qui varie.
Une ligne=une entrée
une entrée= plusieur champs (qui sont les différentes colonnes)
Ton besoin additionné selon un critère sur un champs.
Si une application de ta macro= une somme alors inutil d'utiliser un dictionnaire
une simple bloucle

k=1
Do while (StrComp(feuille.Cells(k, 1).Value,"" )<>0)
   s=0 ' le résultat de ta somme
   if (StrComp(feuille.Cells(k, 2).Value,"la valeur que tu veux" )=0) then
      s=s+feuille.Cells(k, 2).Value
   End if
loop

Ton vu que ça m'a l'air un peu trop simple, je pense ne pas avoir saisi ton soucis  

Hello
 
foxley_gravity est une fille ? Non parceque la tu donnes les reponses direct !!
 
Si tu veux foxley_gravity, mon mail est dans mon profil. Il me semble qu'on a deja travaillé ensemble non ?
Envoie le fichier et je le partagerai ici...

merde je suis démasqué    
en fait il se trouve que ces des bouts du code que je suis en train d'écrire  

Bonjour  
 
désolé d'embéter tout le monde à  la plage lol!
Je vous remercie d'avance
 
 
mais J'ai toujours mon petit probème avec une macro ...  
Je ne comprend pas car elle marche sur des exemples simples maisi l y a doit y avoir une erreur de logique ... car sur le vrai exemple beucoup plus long , la macro ne s'arrete pas apres avoir sélectionné le bon titre , elle continue  
 
+je n'arrive pas à imposer a ma macro de commencer a sommer 5 lignes apres avoir sélectionner le titre sélectionné ( ici x ) et surtout ma macro ne s'arrete pas apres , elle continue a sommer les valeurs des titres suivants  
info suplémentaire : entre chaque montant il y a 1 blanc  
entre le dernier montant d'un titre , et le premier du suivant il y a 2 blanc ... donc j'aimerais des qu'il y a 2 blanc qu'elle s'arrête ...  
 
Voici la macro (qui ouvre le fichiercible  avec les titres ,les montant.. pour copier la somme dans le fichier ouvert)  deja écrite

Sans avoir lu le début mais juste pour ça tu fais une boucle avec un compteur. Si tu trouves un blanc t'incrémentes sinon tu remets à 0. Si le compteur =2 alors t'arrêtes.

tu pourais pas lire le début parce franchement , je suis allez au delas de met limite ^^ ,  ps des que j'ai réussir  à résoudre ces 3 probleme , je vous embete plus jamais de la vie entiere

Les limites de l'orthographe par contre sont largement dépassées là... Si tu codes aussi bien que t'écris je comprends que rien ne marche.
 
 
J'ai pas trop compris ton code, en même temps vu le peu de commentaires ça n'aide pas.

nom ligne 6 ,sinistre ligne 10 , titre ligne  2
On créer un dictionnaire ( outil complexe ) qui va venir lire toutes les lignes de la 2eme colonne et sélectionner la clé qui nous interesse ( correspondant au titre des partenaires)
 

Dim i As Integer
Dim lastline As Integer
Dim star_line As Integer
 
'ouverture des fichiers
 
Workbooks.Open Filename:="F:\013_DirFinTech\042_DptEtudes\018_SrvSupFiabSI\SOP - Support Offres Produits\Inventaire emprunteurs\Laurent\fichier nécessaire2\2008Sinistres02062009.xls"
Workbooks("2008Sinistres02062009.xls" ).Worksheets("PREVIsin2008" ).Activate
 
 
With ActiveSheet
last_line = Cells(65536, 10).End(xlUp).Row
start_line = 5 ' ligne ou l'on commence le décompte
Dim tab1
Set tab1 = CreateObject("Scripting.Dictionary" )
old_cle = ""
For i = start_line To last_line
    If Cells(i, 2) = "" Then
        cle = old_cle
    Else
        cle = Cells(i, 2)
        old_cle = cle
    End If
   
    If Cells(i, 10) <> 0 Then
        If tab1.exists(cle) Then
            tmp = tab1(cle)
            tmp(0) = tmp(0) + Cells(i, 10) ' cumul des sommes
            tmp(1) = tmp(1) & " " & Cells(i, 6) ' cumul des noms
      
            tab1(cle) = tmp
        Else
            tab1(cle) = Array(Cells(i, 10), Cells(i, 6))
        
        End If
        
       
    End If
 
 
Next
 
cle = "PREVI AVENIR" ' à chaque fois qu'il a ce mot , la macro enregistre la valeur des sinistres correspondants
tmp = tab1(cle)
 
End With
 
 
Workbooks(1).Worksheets(1).Activate
With ActiveSheet
'Insertion de la somme
 
 
'Insertion du commentaire
 
Cells(2, 5).ClearComments
Cells(2, 5).Select
Cells(2, 5).AddComment
Cells(2, 5).Comment.Text Text:=tmp(1) 
 
 
End With
 
 
End Sub

Mais c'est où que tu vérifies que t'as croisé 2 lignes vides ?

Je comprends pas ta question désolé...

T'as dit que tu voulais arreter ta routine dès que t'avais 2 lignes vides de suite. Où est la portion du code pour ce point là ?

exact , dans mon programme c'était juste une différent de 0  
c'est instruction est correcte ?  
if 2*Cells(i, 10) <> "" Then

Après avoir réfléchi à la signification de ta ligne, à ton avis ?

Sinon je t'ai expliqué comment faire :

Et pour tester si une cellule est vide il me semble que c'est Cells(...).Text = ""

Avec ça tu as tout pour adapter ça à ton programme normalement.

ok , j'ai essayé de suivre tes instructions, cela te convient ?
 
 

Sub l()
 
Dim j, i As Single
 
 
For i = 0 To 2
 
 
For j = 0 To 100
 
 
If Cells(j, 10) <> "" Then
 
i = i + 1
 
Else
 
i = 0
 
Next j
 
Next i
 
End Sub

ps : Cells(...).Text = "" ne marchait pas  
 

En tout cas ça m'étonnerait que Cells(j, 10) <> "" fonctionne étant donné que Cells est un objet et pas un string.
 
Il sert à quoi ton For i ? Il est où ton test qui vérifie si i=2 ?

oula désolé je susi fatigé  
 

Sub l()
Dim i, j As Single
 
If Cells(i, 10) <> "" Then
 
j = j + 1
 
Else
j = 0
 
If j > 2 Then Exit For
 
Next i
  
 End Sub

non mais va dormir 2-3 mois quoi et réviens après...
 
Tu écris n'importe quoi, n'importe comment, tu te relis pas, tu n'essayes pas de comprendre ce que tu fais...

Tiens Deamon à cracker avant moi
Bon pour info il me semble qu'il manque entre autre des Enf If
Ensuite je ne sais pas d'ou sort le next mais bon j'ai laché ce sujet depuis un petit trop de temps, sorry    
 
folex_gravity, puis-je te demander si tu as ouvert une documentation?
Non car on veut bien aider, mais si tu connais même pas les base, c'est pas la peine    
Demande directement si y a pas une bonne ame pour faire ton boulot à ta place ...
Donc le minimum ftp://ftp-developpez.com/tahe/fic [...] script.pdf,
C'est du VBS ok, mais je ne connais pas de doc équivalente en VBA et les bases sont communes

Je suis pas sur que ça convienne la doc VBS. Déjà un cours d'algorithme ça serait mieux pour la base de la base. Après c'est que de la syntaxe.

Et oui il manque un end if, on a un next sans for, i et j sont des single (nombres flottants) il serait plus adapté d'avoir Integer (voire Long si besoin), j n'est pas initialisé (avec un peu de chance par défaut c'est 0 mais bon...)... Et il faudrait vérifié que Cells(i, 10) <> "" fonctionne.
Bref c'est pas demain que foxley_gravity va nous coder le prochain Windows.

T'es conscient que dans ton : Do While Cells(i, 1) <> ""
est une boucle infinie ? i n'est pas modifié dedans donc si tu rentres peu de chance que tu en sortes avant que ton pc plante.

Non mais avant de coder écris l'algo en français ! Car j'ai pas l'impression que ce soit clair pour toi ce que tu veux faire.

Pas d'accord    
C'est avec des gens comme lui, plein de bonne volonté qu'est né windows, y a qu'a voir le produit à l'arrivée    
 
 

ca veut aussi dire qu'il n'a même pas testé le code  

merci pour le compliment c'est si rare ^^  
et maitenant je pense à mno pc avant de tester lol ,je prefere vous en faire part avant , la pauvre bête...
 
mais franchement , il y a un minimun de logique  
 

Sub v()
 
Dim i, j As Integer
j = 0
Do While j > 2
For i = 1 To 15
If Cells(i, 1) <> "" Then
j = j + 1
Else
j = 0
 
Next i
Loop
 
End Sub

ouai ben non  
1 tu réfléchis
2 tu codes
3 tu testes
4 tu debug
5 tu reflechis
6 tu codes
...
et ça autant de fois que possible  
et tu viens que lorsque que ca fait au moins une heure que tu réflechis sur la même question
 
   
la suite sans moi

j=0
Do While j>2

tu m'expliques quand est-ce que tu rentres dans la boucle?
t'as encore oublié le Enf if    
et puis je t'en laisse
 
Commence par apprendre le vbs comme je te l'ai dit  
Et puis le conseil de deamon sur l'algorithmique est pas faux...

Faudrait déjà que son code compile pour le tester.    
 
Et xme tu es aussi bon à écrire mon pseudo que foxley_gravity à écrire son code.    
 
foxley_gravity > sans déconner écris le fonctionnement de ton algo en français avant de le coder (ex: on regarde si la cellule est vide si oui alors... si non... etc.), en l'écrivant tu verras bien que quelque chose ne va pas.

Je suis profondément vexé    
 
   
c'est corrigé
(au fait j'ai peut être mal compris, c'était peut être un encouragement à foxley_gravity, il ne manquait qu'un "a" dans ton pseudo ^^)
 
Edit :et merde

Il me semble qu'ailleurs tu avais aussi écrit "demaon" ou "daemon" enfin bref pas grave j'ai l'habitude.
C'est comme ton quote foiré personne ne dira rien.

bon je crois que c'est bon , alors les petits joueur de vba attention à vos yeux ( ou pas )  ( humour + dérision )
 

Sub v()
 
Dim i, j As Integer
j = 0
i = 1
 
    While j < 2
            If Cells(i, 1) = "" Then
        j = j + 1
        i = i + 1
            Else
        j = 0
        i = i + 1
             End If
         
    Wend
      
 
 
 
 
MsgBox (i - 1)
 
End Sub

Bien. On s'approche d'un truc correct.
 
Pour chipoter tu peux mettre le i = i + 1 après le end if pour éviter de le répéter 2 fois.
Il ne reste plus qu'à tester le If Cells(i, 1) = ""

ben c'est fait et il marche ... maitenant ca je l'introduit à quelque ligne dans ma macro lol , allez j'ai fait le plus gros du travail mdr , tu peux me dire au moins ca !!  à mon avis faut faire quelques modifications ...

bon j'ai éssaye d'inserer le code , j'aimerais vous me dites si je l'est bien inserer .....et  pourqoui il plante à un endroit avec incompatibilité  de type pour
Cells(1, 1) = tmp(0)
 

Sub m()
 
 
Dim i As Integer
Dim lastline As Integer
Dim star_line As Integer
 
 
Workbooks.Open Filename:="F:\013_DirFinTech\042_DptEtudes\018_SrvSupFiabSI\SOP - Support Offres Produits\Inventaire emprunteurs\Laurent\fichier nécessaire2\2008Sinistres02062009.xls"
Workbooks("2008Sinistres02062009.xls" ).Worksheets("PREVIsin2008" ).Activate
'MsgBox Workbooks(1).Name
'MsgBox Workbooks(2).Name
 
 
With ActiveSheet
last_line = Cells(65536, 10).End(xlUp).Row
start_line = 5 ' ligne ou l'on commence le décompte
Dim tab1
Set tab1 = CreateObject("Scripting.Dictionary" )
old_cle = ""
For i = start_line To last_line
    If Cells(i, 2) = "" Then
        cle = old_cle
    Else
        cle = Cells(i, 2)
        old_cle = cle
    End If
   
      
     If Cells(i, 10) = "" Then
    
      j = j + 1
      
                  
    
        If tab1.exists(cle) Then
            tmp = tab1(cle)
            tmp(0) = tmp(0) + Cells(i, 10) ' cumul des sommes
            tmp(1) = tmp(1) & " " & Cells(i, 6) ' cumul des noms
      
            tab1(cle) = tmp
        Else
            tab1(cle) = Array(Cells(i, 10), Cells(i, 6))
        
        End If
        
      
      Else
      j = 0
        
        
      'MsgBox (Cells(i, 10))
        
    End If
i = i + 1
 
Next
 
cle = "PREVI AVENIR"
tmp = tab1(cle)
 
End With
 
Workbooks(1).Worksheets(1).Activate
With ActiveSheet
'Insertion de la somme
 
Cells(1, 1) = tmp(0)
 
 
'Insertion du commentaire
 
Cells(1, 1).ClearComments
Cells(1, 1).Select
Cells(1, 1).AddComment
Cells(1, 1).Comment.Text Text:=tmp(1)
 
 
End With
 
End Sub

Parce que Cells est un objet Cell et tmp on ne sait même pas ce que c'est vu que tu ne l'as pas déclaré.
Mais il faut écrire dans un champ de Cell style value, text, formula...

c'est bysarre parce qu'avant la modif , tout marchait bien .. tu es sur alors que le probleme vient de la ?  
 
"Mais il faut écrire dans un champ de Cell style value, text, formula..."
J'ai éssayais en rajoutant .value , mais même résultat , quelles modifs je peux faire d'autre ?

J'ai jamais vu dans ton code avant "Cells(1, 1) = tmp(0)" donc faudra m'expliquer pourquoi tu dis que ça a déjà marché ?
 
Regarde la doc de Cell pour voir ce qu'il y a dedans comme champ intéressant.
 
Et déclares ton tmp je t'ai dit aussi.