VBA : erreur de compilation

[Résolu]
Signaler
Messages postés
42
Date d'inscription
lundi 25 février 2008
Statut
Membre
Dernière intervention
24 février 2011
-
Messages postés
42
Date d'inscription
lundi 25 février 2008
Statut
Membre
Dernière intervention
24 février 2011
-
Bonjour a tous,

J'ai un problème avec un petit programme que j'ai fait pour trier un fichier excel. quand je test mon programme il me génere une erreur de compilation "Boucle sans Do" et il pointe sur "Loop"

Pourtant dans ma boucle il y a bien un Do

voila mon programme:

Sub testpoint()

Sheets("U2_S27_2011").Select

Dim R As Long, S As Long, A As Long, i As Long, j As Long, x As Long

i = 0
j = 1
A = 0
x = 0

For i = 0 To 2253
Do While x = 0
i = i + 1
j = j + 1
R = Sheets("U2_S27_2011").Cells(14, i).Value
S = Sheets("U2_S27_2011").Cells(14, j).Value
If R = S Then
A = A + Sheets("U2_S27_2011").Cells(9, i).Value + Sheets("U2_S27_2011").Cells(9, j).Value
Else
x = 1
Loop
Sheets("U2_S27_2011").Cells(15, i).Value = A
A = 0
j = j + 1
Next i
End Sub

J'ai une liste de commandes triés par ville (col 14)

Col 9 Col 14 col 15

5,477 AJACCIO
0,001 AJACCIO
0,02 AJACCIO
4,592 AJACCIO 10,09
0,091 ALBON
0,2 ALBON 0,291
0,69 AMIENS
0,011 AMIENS
0,058 AMIENS
0,206 AMIENS
0,22 AMIENS 1,185
0,22 MARLY

Je voudrais calculer dans la col 15 à la fin de chaque ville la somme des commandes pour chaque ville, Est ce que mon programme est bon? y a t il une formule sous excel qui fait ca plus simplement?

Je m'excuse je suis DEBUTANT en VBA.
Merci pour votre aide c'est assez urgent!

2 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
78
Salut
Première chose : utiliser l'indentation de code et les outils de coloration disponibles = plus pratique à lire :
    Dim R As Long, S As Long, A As Long, i As Long, j As Long, x As Long
    
    i = 0
    j = 1
    A = 0
    x = 0
    
    For i = 0 To 2253
        Do While x = 0
            i = i + 1
            j = j + 1
            R = Sheets("U2_S27_2011").Cells(14, i).Value
            S = Sheets("U2_S27_2011").Cells(14, j).Value
            If R = S Then
                A = A + Sheets("U2_S27_2011").Cells(9, i).Value + Sheets("U2_S27_2011").Cells(9, j).Value
            Else
                x = 1
            ?????????????????
        Loop
        Sheets("U2_S27_2011").Cells(15, i).Value = A
        A = 0
        j = j + 1
    Next i
Et on s'aperçoit vite qu'il manque un End If

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
42
Date d'inscription
lundi 25 février 2008
Statut
Membre
Dernière intervention
24 février 2011

Merci pour la réponse! je pouvais faire mon tri juste avec un tableau croisée dynamique c'etait plus simple! sinon j'ai quand meme réussi à corriger mon Code VBA et il marche tres bien pour ceux qui sont interessés :



Sub testpoint()

 Sheets("U2_S27_2011").Select

Dim R As Variant, S As Variant, y As Double, i As Long, j As Long, x As Long, a As Long, b As Long, c As Long


i = 0
j = 1
a = 0
x = 0

For c = 0 To 2253
'do while Sheets("U2_S27_2011").Cells(14, i).Value <> ""

    Do While x = 0
            
        i = i + 1
        j = j + 1
        
        R = Sheets("U2_S27_2011").Cells(i, 14).Value
        S = Sheets("U2_S27_2011").Cells(j, 14).Value
        
        If R = S Then
         
            y = y + Sheets("U2_S27_2011").Cells(i, 9).Value
        Else
            y = y + Sheets("U2_S27_2011").Cells(i, 9).Value
            x = 1
            
        End If
    Loop
    
    Sheets("U2_S27_2011").Cells(i, 15).Value = y
    
    y = 0
    x = 0
    'i = i + 1
    'j = j + 1
    c = i
'Loop

Next c

b = 1

For a = 1 To 2253
    
    If Sheets("U2_S27_2011").Cells(a, 15).Value <> "" Then
        Sheets("U2_S27_2011").Cells(b, 17).Value = Sheets("U2_S27_2011").Cells(a, 14).Value
        Sheets("U2_S27_2011").Cells(b, 18).Value = Sheets("U2_S27_2011").Cells(a, 15).Value
        b = b + 1
    End If
Next a

Range("Q1:R2253").Sort Key1:=Range("R1"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Columns("O:O").Select
Selection.ClearContents
        
End Sub