boucler sur les valeurs d'une colonne

Cindy · 26 Janvier 2011

Bonjour,

Je souhaiterais faire une boucle sur un ensemble de macro. Pour faire simple j'ai tout regroupé en un seul module...

Une des macros consiste à récupérer la valeur de la 1ère cellule d'une colonne et de la comparer avec la cellule d'une autre feuille puis de lancer une autre macro concernant cette cellule...La boucle consiste à choisir ensuite la 2ème cellule de la colonne, lancer les macros, puis la 3ème, etc.

Mon problème est que je n'arrive pas à lancer la comparaison sur la cellule en y intégrant la boucle. Pour me faire comprendre, voici mon écriture:

Code:

Dim a As Integer
    For a = 32 To 62
    Cells(a, 2).Select

[...]

Sheets("Liste des communes").Select
  recupcom = Cells(a, 2)

[...]

Quelqu'un a t'il la solution?

James007 · 26 Janvier 2011

Re : boucler sur les valeurs d'une colonne

Bonjour Cindy,

Tes efforts d'explication sont très louables ...

Cependant, il serait souhaitable que tu joignes ton fichier ou un bout significatif ... pour éclairer notre lanterne ...

A +
🙂

Cindy · 26 Janvier 2011

Re : boucler sur les valeurs d'une colonne

J'ai beau le réduire mon fichier est trop gros...

Le principe est:
feuille 1 "EXPORT"--> données sur les communes
feuille 2 "Liste des communes"--> une liste déroulante (en format) avec commune à choisir mais pour faciliter la chose j'ai inscris le nom des communes sur une colonne
--> bouton qui lance la 1ère macro visant à comparer le nom de la commune selectionnée avec le nom en EXPORT et tout recopier en feuille 3
feuille 4 "ETAT"--> grâce à un bouton lance la 2ème macro visant à construire un tableau de données avec calculs sur la commune en question.

Voici l'écriture de ma macro pour n'en faire qu'une:

Code:

Sub lancement_roles()

'BOUCLE SUR LISTE DES COMMUNES

Dim a As Integer
        For a = 32 To 62
        Cells(a, 2).Select


'TRAITEMENT PAR COMMUNE

Sheets("commune").Select
Cells.Select
Selection.ClearContents

col1 = ""
col2 = ""
col3 = ""
col4 = ""
col5 = ""
col6 = ""
col7 = ""
col8 = ""
col9 = ""
col10 = ""
col11 = ""
col12 = ""
col13 = ""
col14 = ""
col15 = ""
col16 = ""
col17 = ""
col18 = ""
col19 = ""
col20 = ""
col21 = ""
col22 = ""

recupcom = ""
comparecom = ""
L = 0
c = 0
la = 0
ca = 0

[COLOR="red"]Sheets("Liste des communes").Select
    
    recupcom = Cells(a, 2)[/COLOR]

L = 2
c = 2
la = 1
ca = 1

Sheets("EXPORT").Select
comparecom = Cells(L, c - 1)

While comparecom <> ""
    
    If comparecom = recupcom Then
        col1 = Cells(L, c - 1)
        col2 = Cells(L, c)
        col3 = Cells(L, c + 1)
        col4 = Cells(L, c + 2)
        col5 = Cells(L, c + 3)
        col6 = Cells(L, c + 4)
        col7 = Cells(L, c + 5)
        col8 = Cells(L, c + 6)
        col9 = Cells(L, c + 7)
        col10 = Cells(L, c + 8)
        col11 = Cells(L, c + 9)
        col12 = Cells(L, c + 10)
        col13 = Cells(L, c + 11)
        col14 = Cells(L, c + 12)
        col15 = Cells(L, c + 13)
        col16 = Cells(L, c + 14)
        col17 = Cells(L, c + 15)
        col18 = Cells(L, c + 16)
        col19 = Cells(L, c + 17)
        col20 = Cells(L, c + 18)
        col21 = Cells(L, c + 19)
        col22 = Cells(L, c + 20)
        
        Sheets("commune").Select
        Cells(la, ca) = col7
        Cells(la, ca + 1) = col1
        Cells(la, ca + 2) = col4
        Cells(la, ca + 3) = col5
        Cells(la, ca + 4) = col8
        Cells(la, ca + 5) = col9
        Cells(la, ca + 6) = col10
        Cells(la, ca + 7) = col11
        Cells(la, ca + 8) = col12
        Cells(la, ca + 9) = col6
        Cells(la, ca + 10) = col2
        Cells(la, ca + 11) = col3
        Cells(la, ca + 12) = col13
        Cells(la, ca + 13) = col14
        Cells(la, ca + 14) = col15
        Cells(la, ca + 15) = col16
        Cells(la, ca + 16) = col17
        Cells(la, ca + 17) = col18
        Cells(la, ca + 18) = col19
        Cells(la, ca + 19) = col20
        Cells(la, ca + 20) = col21
        Cells(la, ca + 21) = col22
        la = la + 1
    End If
    Sheets("EXPORT").Select
    L = L + 1
    comparecom = Cells(L, c - 1)

Wend

    

Sheets("ETAT").Select
Range("A5:Z8000").Select
Selection.ClearContents
Selection.ClearFormats

'CONSTRUCTION TABLEAU

Sheets("Commune").Select
L = 0
c = 0
la = 0
ca = 0
propriétaire = ""
section = ""
numéro = ""
classe = ""
surface = ""
degrés = ""
vannage = 0
tc1 = 0
td1 = 0#
tc2 = 0
td2 = 0#
tc3 = 0
td3 = 0#
tc4 = 0
td4 = 0#
tc5 = 0
td5 = 0#
tcHC = 0
tdHC = 0#
surtot = 0
dtot = 0
totsur = 0
tarif = 0#
affpop = 0
payer = 0#
surglobal = 0
dglobal = 0
dvan = 0
adresse = ""
cptprod = 0
amont = ""
prénom = ""


van = ""
com = ""
L = 1
c = 1
la = 5
ca = 1
cpt = 0

Sheets("Commune").Select

wpropriétaire = Cells(L, c + 10) & " " + Cells(L, c + 11)
wnuméro = Cells(L, c + 3)
wsection = Cells(L, c + 2)
cptprod = 1

propriétaire = Cells(L, c + 10) & " " + Cells(L, c + 11)
prénom = Cells(L, c + 11)
numéro = Cells(L, c + 3)
section = Cells(L, c + 2)
adresse = Cells(L, c + 18) & " " & Cells(L, c + 19) & " " & Cells(L, c + 20) & " " & Cells(L, c + 21)
While wpropriétaire <> " "
        While wpropriétaire = propriétaire

                While numéro = wnuméro And section = wsection
    
                    
                    classe = Cells(L, c + 8)
                    surface = Cells(L, c + 6)
                    degrés = Cells(L, c + 17)
                    van = Cells(L, c + 15)
                    vannage = Cells(L, c + 16)
                    tarif = Cells(L, c + 14)
                    amont = Cells(L, c + 12)
                    If amont = True Then
                        If classe = 1 Then
                            tc1 = tc1 + surface
                            dc1 = dc1 + degrés
                        End If
                        If classe = 2 Then
                            tc2 = tc2 + surface
                            dc2 = dc2 + degrés
                        End If
                        If classe = 3 Then
                            tc3 = tc3 + surface
                            dc3 = dc3 + degrés
                        End If
                        If classe = 4 Then
                            tc4 = tc4 + surface
                            dc4 = dc4 + degrés
                        End If
                        If classe = 5 Then
                            tc5 = tc5 + surface
                            dc5 = dc5 + degrés
                        End If
                        If classe = "HC" Then
                            tcHC = tcHC + surface
                            dcHC = dcHC + degrés
                        End If
                        surtot = tc1 + tc2 + tc3 + tc4 + tc5 + tcHC
                        dtot = dc1 + dc2 + dc3 + dc4 + dc5 + dcHC
                    Else
                        If classe = 1 Then
                            tc1 = tc1 + surface
                            dc1 = 0
                        End If
                        If classe = 2 Then
                            tc2 = tc2 + surface
                            dc2 = 0
                        End If
                        If classe = 3 Then
                            tc3 = tc3 + surface
                            dc3 = 0
                        End If
                        If classe = 4 Then
                            tc4 = tc4 + surface
                            dc4 = 0
                        End If
                        If classe = 5 Then
                            tc5 = tc5 + surface
                            dc5 = 0
                        End If
                        If classe = "HC" Then
                            tcHC = tcHC + surface
                            dcHC = dcHC + degrés
                        End If
                        surtot = tc1 + tc2 + tc3 + tc4 + tc5 + tcHC
                        dtot = dc1 + dc2 + dc3 + dc4 + dc5 + dcHC
                    End If
                    L = L + 1
                    numéro = Cells(L, c + 3)
                    section = Cells(L, c + 2)
                Wend
                Sheets("ETAT").Select
                If affpop = 0 Then
                    Cells(la, ca) = cptprod
                    Cells(la, ca + 1) = wpropriétaire
                    la = la + 1
                    Cells(la, ca + 1) = adresse
                    la = la + 1
                    cptprod = cptprod + 1
                    affpop = 1
                End If
                Cells(la, ca + 2) = wsection
                Cells(la, ca + 3) = wnuméro
                Cells(la, ca + 4) = tc1
                Cells(la, ca + 5) = Round(dc1, 1)
                Cells(la, ca + 6) = tc2
                Cells(la, ca + 7) = Round(dc2, 1)
                Cells(la, ca + 8) = tc3
                Cells(la, ca + 9) = Round(dc3, 1)
                Cells(la, ca + 10) = tc4
                Cells(la, ca + 11) = Round(dc4, 1)
                Cells(la, ca + 12) = tc5
                Cells(la, ca + 13) = Round(dc5, 1)
                Cells(la, ca + 14) = tcHC
                Cells(la, ca + 15) = Round(dcHC, 1)
                If van = True Then
                    Cells(la, ca + 17) = "1"
                    Cells(la, ca + 18) = vannage
                    dvan = vannage
                Else
                    Cells(la, ca + 17) = "0"
                    Cells(la, ca + 18) = ""
                End If
                la = la + 1
                tc1 = 0
                dc1 = 0
                tc2 = 0
                dc2 = 0
                tc3 = 0
                dc3 = 0
                tc4 = 0
                dc4 = 0
                tc5 = 0
                dc5 = 0
                tcHC = 0
                dcHC = 0
                van = ""
                vannage = 0
                Sheets("Commune").Select
                wnuméro = numéro
                wsection = section
                propriétaire = Cells(L, c + 10) & " " + Cells(L, c + 11)
                prénom = Cells(L, c + 11)
                cpt = cpt + 1
                surglobal = surglobal + surtot
                dglobal = dglobal + dtot
                dtot = 0
                surtot = 0
       Wend
        Sheets("ETAT").Select
        Selection.Font.Bold = True
        Cells(la - 1, ca + 16) = surglobal
        Cells(la - 1, ca + 19) = Round(dglobal + dvan, 0)
        payer = (dglobal + dvan) * tarif
        If payer > 8 Then
            Cells(la - 1, ca + 22) = Round((dglobal + dvan) * tarif, 2)
        Else
            If dglobal <> 0 Then
                If dglobal > 0.5 Then
                    Cells(la - 1, ca + 22) = 8#
                Else
                    Cells(la - 1, ca + 22) = 0#
                End If
            Else
            Cells(la - 1, ca + 22) = 0#
            End If
        End If
        Selection.Font.Bold = False
        Rows(la - 1).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
        End With
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        If cpt < 1 Then
            With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
            End With
        End If
        Cells(la - 1, 1).Select
        surtot = 0
        dtot = 0
        payer = 0
        cpt = 0
        surglobal = 0
        dglobal = 0
        dvan = 0
        vannage = 0
        Sheets("Commune").Select
        wpropriétaire = propriétaire
        cp = ""
        If Len(Cells(L, c + 20)) < 5 Then
            cp = "0" & Cells(L, c + 20)
        Else
            cp = Cells(L, c + 20)
        End If
        adresse = Cells(L, c + 18) & " " & Cells(L, c + 19) & " " & cp & " " & Cells(L, c + 21)
        affpop = 0
        cp = ""
    Wend
Sheets("ETAT").Select
Range("C5:Z800").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    'With Selection.Borders(xlEdgeTop)
    '    .LineStyle = xlContinuous
    '    .Weight = xlThin
    '    .ColorIndex = xlAutomatic
    'End With
    'With Selection.Borders(xlEdgeBottom)
    '    .LineStyle = xlContinuous
    '    .Weight = xlMedium
    '    .ColorIndex = xlAutomatic
    'End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    'With Selection.Borders(xlInsideHorizontal)
    '    .LineStyle = xlContinuous
    '    .Weight = xlThin
    '    .ColorIndex = xlAutomatic
    'End With
    Range("A5:A800").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    'With Selection.Borders(xlEdgeTop)
    '    .LineStyle = xlContinuous
    '    .Weight = xlThin
    '    .ColorIndex = xlAutomatic
    'End With
    'With Selection.Borders(xlEdgeBottom)
    '    .LineStyle = xlContinuous
    '    .Weight = xlMedium
    '    .ColorIndex = xlAutomatic
    'End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
'calcul de somme en fin de tableaux + export feuille dans un autre fichier

Dim x As Integer
x = Range("Q65536").End(xlUp).Row
Range("Q" & x + 1) = Evaluate("sum(Q2:Q" & L & ")")

Dim Y As Integer
Y = Range("T65536").End(xlUp).Row
Range("T" & Y + 1) = Evaluate("sum(T2:T" & L & ")")

Dim Z As Integer
Z = Range("Q65536").End(xlUp).Row
Range("W" & Z + 1) = Evaluate("sum(W2:W" & L & ")")
  
Sheets("ETAT").Select
Sheets("ETAT").Copy Before:=Workbooks("Roles.xls").Sheets(1)
ActiveSheet.Name = Sheets("ETAT").Range("B1")
Range("B1").Value = ActiveSheet.Name


Next a

End Sub

Désolée pour la longueur du script!

KenDev · 27 Janvier 2011

Re : boucler sur les valeurs d'une colonne

Bonjour Cindy, bonjour le fil,

Voici un lien pour nous transmettre ton fichier :

HTML:

http://www.cijoint.fr/

Ton code pourrait être optimisé à coup sûr 🙂 Mais sans le fichier je pense qu'on va ramer.

Quelques remarques quand même:

VB:

        Cells(a, 2).Select

Tu ne fais que sélectionner la cellule sans rien y faire. A supprimer.

VB:

Sheets("commune").Select
Cells.Select
Selection.ClearContents

Les selects sont à éviter dans du code, ça ralentit pour rien.

VB:

Worksheets("commune").Cells.ClearContents

VB:

col1 = ""
col2 = ""
col3 = ""
col4 = ""
col5 = ""
col6 = ""
col7 = ""
col8 = ""
col9 = ""
col10 = ""
col11 = ""
col12 = ""
col13 = ""
col14 = ""
col15 = ""
col16 = ""
col17 = ""
col18 = ""
col19 = ""
col20 = ""
col21 = ""
col22 = ""

Oula!🙂
En tête de macro

VB:

Dim col() as String

Ceci déclare une variable tableau. Ensuite dans le corps du code :

VB:

Redim col(1 to 22)
For i = 1 to 22
    col(i)=""
next i

Tu y indiques que ce tableau contient 22 éléments et tour à tour tu leur affecte la valeur souhaitée.

VB:

recupcom = ""
comparecom = ""
L = 0
c = 0
la = 0
ca = 0

Déclare tes variables en début de code avec les Dim as ... pour t'y obliger mettre en début de module (au dessus de ton instruction Sub)

VB:

Option explicit

Ce n'est pas obligatoire, un peu contraignant, mais fortement conseillé pour t'y retrouver.

VB:

[COLOR="red"] Sheets("Liste des communes").Select
   
    recupcom = Cells(a, 2)[/COLOR]

Les machins entre crochets ça n'existe pas en vba. Si tu souhaitais colorier la cellule en rouge :

VB:

Worksheets("Liste des communes").Activate
  recupcom = Cells(a, 2)
cells(a,2).Interior.ColorIndex = 4

J'ai mis un code couleur au hasard. à adapter.

Bref, envoie ton fichier. Cordialement

Cindy · 27 Janvier 2011

Re : boucler sur les valeurs d'une colonne

Voici mon fichier "épuré": Cijoint.fr - Service gratuit de dépôt de fichiers

Il faut reprendre ce que j'ai écris plus haut pour comprendre...

Merci de votre aide!

PS: le fichier et les macros en question ont été réalisés il y a longtemps par une autre personne, c'est pourquoi je cherche à ne faire qu'une seule application...

KenDev · 27 Janvier 2011

Re : boucler sur les valeurs d'une colonne

Bonjour Cindy, bonjour le fil.

Le code est illisible et, à mon sens, tout serait à reprendre à zéro. Je viens d'y passer un certain temps pour pas grand chose, je le crains. Merci pour le fichier mais il aurait fallu que chaque feuille contiennent au moins deux lignes de vraies données (et non pas rien, ou des xxx etc..) pour avoir une chance de s'y retrouver. Pour des raisons de confidentialité remplace tout ce qui noms propres par des données imaginaires mais de même nature (Jean Pierre Durand, Alphonsine Tartenpion, Cucugnan les oies...)

De plus le code est vide de commentaire, il faudrait qu'à chaque paragraphe on ait une description de ce que le bout de code suivant est censé faire. La personne qui a fait ce code ne t'aime pas beaucoup... 🙁 🙄

Bref, si tu peux retransmet le fichier en tenant compte de ça. J'écris quand même ce que j'ai commencé, je n'ai corrigé que des trucs assez évidents et n'ai pas pu vraiment toucher à l'architecture pour les raisons données.

Cordialement.

VB:

Sub lancement_roles()

'BOUCLE SUR LISTE DES COMMUNES

Dim a As Integer
Dim oWsL As Worksheet 'feuille liste
Dim oWsC As Worksheet 'feuille commune
Dim oWsEx As Worksheet 'feuille export
Dim oWsEt As Worksheet 'feuille etat
Dim Dlc As Integer 'derniere ligne de la liste
Dim col() As String 'tableau
Dim recupcom As String 'commune en cours
Dim comparecom As String
Dim L As Integer
Dim c As Integer
Dim la As Integer
Dim ca As Integer
Dim i As Integer
Dim class
Dim tc()
Dim dc()

    'définitions objets
    Set oWsL = Worksheets("Liste des communes")
    Set oWsC = Worksheets("commune")
    Set oWsEx = Worksheets("EXPORT")
    Set oWsEt = Worksheets("ETAT")
    
    'determiner derniere ligne de la liste (! la colonne 2 ne doit rien avoir d'écrit dessous)
    Dlc = oWsL.Cells(Rows.Count, 2).End(xlUp).Row
    
    For a = 32 To Dlc
    
        'TRAITEMENT PAR COMMUNE
        oWsC.Cells.ClearContents

        recupcom = oWsL.Cells(a, 2)
        L = 2
        c = 2
        la = 1
        ca = 1
        comparecom = oWsEx.Cells(L, c - 1)

        While comparecom <> ""
        
            If comparecom = recupcom Then 'est ce normal que tu compare un nom de commune à ce qui semble être un nom de famille ?
            
                ReDim col(1 To 22)
                For i = 1 To 22
                    col(i) = oWsEx.Cells(L, i) 'i remplace c-1, c,..., c+20
                Next i
        
                For i = 0 To 21
                    Select Case i
                        Case 0
                            oWsC.Cells(la, ca + i) = col(i + 7)
                        Case 1
                            oWsC.Cells(la, ca + i) = col(i)
                        Case 2, 3
                            oWsC.Cells(la, ca + i) = col(i + 2)
                        Case 4 To 8
                            oWsC.Cells(la, ca + i) = col(i + 4)
                        Case 9
                            oWsC.Cells(la, ca + i) = col(i - 3)
                        Case 10, 11
                            oWsC.Cells(la, ca + i) = col(i - 8)
                        Case 12 To 22
                            oWsC.Cells(la, ca + i) = col(i + 1)
                    End Select
                Next i
                
                la = la + 1
                
            End If
            
            L = L + 1
            comparecom = oWsEx.Cells(L, c - 1)
            
        Wend

        Range(oWsEt.Cells(5, 1), oWsEt.Cells(Rows.Count, 26)).ClearContents
        Range(oWsEt.Cells(5, 1), oWsEt.Cells(Rows.Count, 26)).ClearFormats
        
        'CONSTRUCTION
        'Sheets("Commune").Select
        affpop = 0
        payer = 0#
        surglobal = 0
        dglobal = 0
        dvan = 0
        cptprod = 0
        com = ""
        L = 1
        c = 1
        la = 5
        ca = 1
        cpt = 0

        wpropriétaire = oWsC.Cells(L, c + 10) & " " + oWsC.Cells(L, c + 11)
        wnuméro = Cells(L, c + 3)
        wsection = Cells(L, c + 2)
        cptprod = 1

        propriétaire = oWsC.Cells(L, c + 10) & " " + oWsC.Cells(L, c + 11)
        prénom = oWsC.Cells(L, c + 11)
        numéro = oWsC.Cells(L, c + 3)
        section = oWsC.Cells(L, c + 2)
        adresse = oWsC.Cells(L, c + 18) & " " & oWsC.Cells(L, c + 19) & " " & oWsC.Cells(L, c + 20) & " " & oWsC.Cells(L, c + 21)
        
        While wpropriétaire <> " "
        
            While wpropriétaire = propriétaire

                While numéro = wnuméro And section = wsection
    
                    classe = oWsC.Cells(L, c + 8)
                    surface = oWsC.Cells(L, c + 6)
                    degrés = oWsC.Cells(L, c + 17)
                    van = oWsC.Cells(L, c + 15)
                    vannage = oWsC.Cells(L, c + 16)
                    tarif = oWsC.Cells(L, c + 14)
                    amont = oWsC.Cells(L, c + 12)
                    
                    ReDim tc(1 To 6) 'tc(6)=tcHC
                    ReDim dc(1 To 6) 'td(6)=tdHc
                    
                    Select Case classe
                        Case 1 To 5
                            tc(classe) = tc(classe) + surface
                            If amont = True Then
                                dc(classe) = dc(classe) + degrés
                            Else
                                dc(classe) = 0
                            End If
                        Case "HC"
                            tc(6) = tc(6) + surface
                            dc(6) = dc(6) + degrés
                    End Select
                    surtot = 0
                    dtot = 0
                    For i = 1 To 6
                        surtot = surtot + tc(i)
                        dtot = dtot + dc(i)
                    Next i
                    
                    L = L + 1
                    
                Wend
                
                If affpop = 0 Then
                    oWsEt.Cells(la, ca) = cptprod
                    oWsEt.Cells(la, ca + 1) = wpropriétaire
                    la = la + 1
                    oWsEt.Cells(la, ca + 1) = adresse
                    la = la + 1
                    cptprod = cptprod + 1
                    affpop = 1
                End If
                
                oWsEt.Cells(la, ca + 2) = wsection
                oWsEt.Cells(la, ca + 3) = wnuméro
                oWsEt.Cells(la, ca + 4) = tc1
                oWsEt.Cells(la, ca + 5) = Round(dc1, 1)
                oWsEt.Cells(la, ca + 6) = tc2
                oWsEt.Cells(la, ca + 7) = Round(dc2, 1)
                oWsEt.Cells(la, ca + 8) = tc3
                oWsEt.Cells(la, ca + 9) = Round(dc3, 1)
                oWsEt.Cells(la, ca + 10) = tc4
                oWsEt.Cells(la, ca + 11) = Round(dc4, 1)
                oWsEt.Cells(la, ca + 12) = tc5
                oWsEt.Cells(la, ca + 13) = Round(dc5, 1)
                oWsEt.Cells(la, ca + 14) = tcHC
                oWsEt.Cells(la, ca + 15) = Round(dcHC, 1)
                
                If van = True Then
                    oWsEt.Cells(la, ca + 17) = "1"
                    oWsEt.Cells(la, ca + 18) = vannage
                    dvan = vannage
                Else
                    oWsEt.Cells(la, ca + 17) = "0"
                    oWsEt.Cells(la, ca + 18) = ""
                End If
                
                la = la + 1
                tc1 = 0
                dc1 = 0
                tc2 = 0
                dc2 = 0
                tc3 = 0
                dc3 = 0
                tc4 = 0
                dc4 = 0
                tc5 = 0
                dc5 = 0
                tcHC = 0
                dcHC = 0
                van = ""
                vannage = 0
                
                wnuméro = numéro
                wsection = section
                propriétaire = oWsC.Cells(L, c + 10) & " " + oWsC.Cells(L, c + 11)
                prénom = oWsC.Cells(L, c + 11)
                cpt = cpt + 1
                surglobal = surglobal + surtot
                dglobal = dglobal + dtot
                dtot = 0
                surtot = 0
                
            Wend
            
            'ici j'abandonne

Cindy · 1 Février 2011

Re : boucler sur les valeurs d'une colonne

Bonjour,

Est-ce que ça va mieux avec ceci? Cijoint.fr - Service gratuit de dépôt de fichiers

Par contre oui il n'y a rien d'expliqué...Je pense que la personne voulait que cela reste son travail et que l'on y touche pas...

Encore merci pour le travail déja accompli!

KenDev · 1 Février 2011

Re : boucler sur les valeurs d'une colonne

Bonjour Cindy, le fil,

C'est un peu mieux.. 🙂 Mais bon, encore une fois le code est illisible, la personne n'hésite pas à utiliser plusieurs dizaines variables sans les déclarer, avec des noms qui ne renseignent pas (la, c etc..), fait des étapes inutiles, son code n'est pas documenté... Aie, aie, aie..
Je ne peux que confirmer qu'il faut tout reprendre à zéro.
En ce qui concerne la macro

VB:

Sub lancement_roles()

, voilà ce que je crois avoir compris et qu'il faudrait que tu me confirmes:

Objectif : remplir la feuille ETAT d'après les feuilles liste des communes et EXPORT

-1 s'agit t-il d'effacer ce qu'il y avait précédement et de la remplir à nouveau ou d'ajouter de nouveaux enregistrements à l'existant
-2 peut-il arriver dans la feuile EXPORT qu'une personne apparaissent plusieurs fois (ex : Gaston Lefevre peut il avoir 2 lignes ou plus pour la commune SUZANNE?
-3 si la réponse à 2) est oui faut-il accumuler les informations sur un même groupe de 3 lignes dans ETAT ou pas?

Pour la feuille ETAT:, peut tu me confirmer :
colonne 1 : n° unique d'enregistrement des lignes
colonne 2 : ligne 1 Nom & Prénom, ligne 2 adresse 1, ligne 3 adresse 2
colonne 3 : section
colonne 4 : numéro
colonne 5 (ou 7 ou 9 ou...ou 15): classe
Comment est calculée la colonne 6 (ou 8... ou 16) (par rapport aux titres des colonnes de EXPORT) ?
Que représentent les colonnes 17 à 26 (quels calculs toujours d'après les titre colonnes EXPORT) ?

Pour la feuille EXPORT:
Comment est indiqué une classe HC dans cette colonne (il n'y en pas dans ton exemple)

Cordialement

KD

Cindy · 7 Février 2011

Re : boucler sur les valeurs d'une colonne

Bonjour,

Toujours le même problème...

Pour répondre aux questions:

L'Objectif est en fait de remplir la feuille ETAT en sélectionnant la commune dans LISTE DES COMMUNES (le but ultime étant de faire dérouler le liste des communes pour automatiser l'ensemble) et prenant les données de la feuille COMMUNE (données provenant de la feuille EXPORT, cette dernière comporte toutes les données pour toutes les communes alors que COMMUNE contient les données d'une seule commune).

1- Il s'agit bien d'effacer ce qui a été mis et de remplir la feuille à nouveau avec les données concernant une autre commune.
2- Oui effectivement une personne peut apparaitre plusieurs fois.
3- De ce fait, dans le tableau ETAT, le nom de la personne apparait une fois et les lignes correspondantes sont regroupées. La colonne B2 de ETAT comporte le nom de la personne puis on a chacunes des lignes correspondantes à la suite pour cette personne.

Pour la feuille ETAT:
colonne 1: ok
colonne 2: ok
colonne 3: ok
colonne 4: ok
colonne 5 et autres: = "surface" de EXPORT
colonne 6 et autres: = "coefficient" * "surface" de EXPORT
colonne 17 (j'ai supprimé trop d'informations sur le lien): total des classes
colonne 18: indique le nombre de vannages (= "TAB_parcelle" de EXPORT; -1 = 1 vannage, 0 = 0 vannage) et colonne 19 le nombre de degrés corresondants (=colonne "TAB_vannage" de EXPORT).
colonne 20 : total arrondi en nombre entier des colonnes 6 et autres.
colones 21, 22, 24, 25, 26: ne nous servent pas, je ne connais pas pas le calcul s'il y en a un.
Colonne 23: Si colonne 20*"tarif_degré" de EXPORT < 8 --> on inscrit 8, sinon on inscrit le total exact de l'opération.

Pour la feuille EXPORT:
Dans EXPORT, la NATURE donne une CLASSE et la classe un COEFFICIENT. Une classe HC s'écrit HC dans EXPORT mais donne un nombre (coefficient) dans ETAT.

J'espère que je reste claire...Merci encore pour le suivi de mon problème!!!

Cindy · 21 Février 2011

Re : boucler sur les valeurs d'une colonne

Bonjour KenDev,

Avez-vous abandonné sur ce (très) long problème?

KenDev · 22 Février 2011

Re : boucler sur les valeurs d'une colonne

Bonjour Cindy,

C'est vrai que j'avais mis de côté cette horreur... Tu me pardonneras j'espère vu que tu n'est pas l'auteur du code 🙂 Je n'ai pas trop été aidé non plus avec 3 lignes de données sans particularités la ou il en aurait fallu disons quelques dizaines.. Bref j'en suis là :

VB:

Option Explicit

Sub lancement_roles_test()
Dim oWsC As Worksheet, oWsL As Worksheet, oWsE As Worksheet, oWsT As Worksheet
Dim i As Integer, j As Long, k As Long, c As Long
Dim CptP As Long, CptL As Long
Dim p() As Integer, q() As Integer
Dim n As Integer, mx As Integer

'initialise les objets feuilles
Set oWsC = Worksheets("commune")
Set oWsL = Worksheets("Liste des communes")
Set oWsE = Worksheets("EXPORT")
Set oWsT = Worksheets("ETAT")

For i = 32 To oWsL.Cells(Rows.Count, 2).End(xlUp).Row 'pour chaque commune
    
    c = 0 'n° de ligne d'écriture dans "commune"
    oWsC.Cells.ClearContents 'effacer "communes"
    
    'écriture colonnes dans "communes" pour commune en cours
    For j = 2 To oWsE.Cells(Rows.Count, 1).End(xlUp).Row 'pour chaque ligne remplie dans "Export"
        If oWsL.Cells(i, 2) = oWsE.Cells(j, 1) Then 'si la commune "Liste des communes" est égale à la commune "Export"
            c = c + 1
            For k = 1 To 22 'pour chaque colonne à écrire
                Select Case k 'écriture colonne k dans "communes"
                    Case 1
                        oWsC.Cells(c, k) = oWsE.Cells(j, k + 6)
                    Case 2
                        oWsC.Cells(c, k) = oWsE.Cells(j, k - 1)
                    Case 3, 4
                        oWsC.Cells(c, k) = oWsE.Cells(j, k + 1)
                    Case 5 To 9
                        oWsC.Cells(c, k) = oWsE.Cells(j, k + 3)
                    Case 10
                        oWsC.Cells(c, k) = oWsE.Cells(j, k - 4)
                    Case 11, 12
                        oWsC.Cells(c, k) = oWsE.Cells(j, k - 9)
                    Case 13 To 22
                        oWsC.Cells(c, k) = oWsE.Cells(j, k)
                End Select
            Next k
        End If
    Next j
    
    oWsT.Range(oWsT.Cells(5, 1), oWsT.Cells(Rows.Count, 26)).ClearContents 'efface feuille état
    
    'décompte des proprios et des lignes départ et arrivées p(1,n)=deb,p(2,n)=fin
    CptP = 1: CptL = 1: ReDim p(1 To 2, 1 To CptP): p(1, 1) = 1
    For j = 2 To oWsC.Cells(Rows.Count, 11).End(xlUp).Row 'pour chaque ligne de la commune
        If oWsC.Cells(j, 11) & " " & oWsC.Cells(j, 12) = oWsC.Cells(j - 1, 11) & " " & oWsC.Cells(j - 1, 12) Then 'même nom & prénom ?
            If j = oWsC.Cells(Rows.Count, 11).End(xlUp).Row Then
                p(2, CptP) = CptL + 1
                If CptP > 1 Then p(1, CptP) = p(2, CptP - 1) + 1
            End If
        Else
            p(2, CptP) = CptL
            If CptP > 1 Then p(1, CptP) = p(2, CptP - 1) + 1
            CptP = CptP + 1
            ReDim Preserve p(1 To 2, 1 To CptP)
            If j = oWsC.Cells(Rows.Count, 11).End(xlUp).Row Then
                p(2, CptP) = CptL + 1
                If CptP > 1 Then p(1, CptP) = p(2, CptP - 1) + 1
            End If
        End If
        CptL = CptL + 1
    Next j
    
    CptL = 1: ReDim q(1 To CptP, 1 To 2, 1 To 1): q(1, 1, 1) = 1: mx = 1
    'pour chaque proprio, décompte des ensembles numéro-section
    For j = 1 To CptP 'pour chaque proprio
        n = 1 'unité N.S
        For k = p(1, j) To p(2, j) 'pour chaque ligne du proprio
            If oWsC.Cells(CptL + 1, 3) & " " & oWsC.Cells(CptL + 1, 4) = oWsC.Cells(CptL, 3) & " " & oWsC.Cells(CptL, 4) And CptL <> p(2, j) Then  'si numéro et section sont identiques
            Else
                q(j, 2, n) = CptL
                If n > 1 Then
                    q(j, 1, n) = q(j, 2, n - 1) + 1
                Else
                    If j > 1 Then q(j, 1, n) = p(2, j - 1) + 1
                End If
                n = n + 1
                If n > mx Then mx = n
                ReDim Preserve q(1 To CptP, 1 To 2, 1 To mx)
            End If
            CptL = CptL + 1
        Next k
    Next j
    
    CptL = 5
    For j = 1 To CptP
        oWsT.Cells(CptL, 1) = j 'n° d'enregistrement
        oWsT.Cells(CptL, 2) = oWsC.Cells(p(1, j), 11) & " " & oWsC.Cells(p(1, j), 12) 'propriétaire
        oWsT.Cells(CptL + 1, 2) = oWsC.Cells(p(1, j), 19) 'adresse 1
        oWsT.Cells(CptL + 2, 2) = oWsC.Cells(p(1, j), 20) & " " & oWsC.Cells(p(1, j), 21) & " " & _
            oWsC.Cells(p(1, j), 22) 'adresse 2, CP, ville
        If Left(oWsT.Cells(CptL + 2, 2), 1) = " " Then oWsT.Cells(CptL + 2, 2) = Right(oWsT.Cells(CptL + 2, 2), _
            Len(oWsT.Cells(CptL + 2, 2)) - 1) 'si adresse 2 inexistante, ajustement
        oWsT.Cells(CptL + 2, 3) = oWsC.Cells(p(1, j), 3) 'section
        oWsT.Cells(CptL + 2, 4) = oWsC.Cells(p(1, j), 4) 'numéro
        oWsT.Cells(CptL + 2, 18) = Abs(oWsC.Cells(p(1, j), 16)) 'nb de vannages
        oWsT.Cells(CptL + 2, 19) = oWsT.Cells(CptL + 2, 18) * oWsC.Cells(p(1, j), 17) 'nb de degrés correspondants
        CptL = CptL + 3
    Next j
    Stop
    
    
Next i

Set oWsC = Nothing
Set oWsL = Nothing
Set oWsE = Nothing
Set oWsT = Nothing
   
    End Sub

Il me manque des informations : Une même personne peut elle avoir plusieurs entrées dans ETAT ? Je pose la question car dans le code originel (et original) il y a des sous boucles (liée aux classes, tc, td, surtot, dtot, dglobal, surglobal...) dès que, pour une même personne, numéro et/ou section varie. 2ème possibilité est ce que ça veut dire que pour un enregistrement dans Etat il peut y avoir plusieurs lignes de classes selon ces paramètres ? Si la réponse est oui est ce qu'un enregistrement peut avoir une hauteur variable ? Selon la réponse je pourrait déjà supprimer un pavé dans mon code (décompte des ensembles numéro-section).
Autre chose, dans Export les données sont-elles déjà triées selon les colonnes A,B,C,D,E lorsque la macro est lancée?

Cordialement

KD

Cindy · 22 Février 2011

Re : boucler sur les valeurs d'une colonne

Bonjour!

Heureuse de savoir que tu suis encore "l'affaire"...
Pour répondre aux questions:

Dans état, une personne n'apparait qu'une seule fois (1 état correspond à une commune si tu suis toujours) mais elle peut avoir plusieurs parcelles donc plusieurs classes (1 parcelle peut même avoir plusieurs classes) qui apparaissent les unes en dessous-des autres pour cette même personne. La hauteur de l'enregistrement est donc différente en fonction des personnes et de leur nombre de parcelles et du nombre de classes différentes par parcelles.

Et oui dans export les données sont déja triées, elles proviennent d'ailleurs d'une BDD que nous mettons à jours et que nous exportons donc dans ce fameux fichier excel.

Merci encore et toujours pour tout ce travail!

KenDev · 3 Mars 2011

Re : boucler sur les valeurs d'une colonne

Bonjour Cindy,

Voilà un premier essai. Vu les 3 lignes fournies ce n'est quasiment pas testé, je ne m'attends pas à ce que ce soit bon du premier coup. A tester donc et surtout vérifier tous les champs, particulièrement ceux calculés, dans toutes les configurations possibles. Si il y a des erreurs cela proviendra probablement d'une mauvaise compréhension et les changements d'un point de vue codage devraient être raisonables pour peu que tu puisses me fournir un échantillon de donnée convenable. On verra à ce moment là.

Pour différencier les propriétaires les uns des autres j'ai considéré que la colonne "Num_Propriétaire" était, pour une commune donnée, unique et qu'elle ne changeait jamais même si le propriétaire avait plusieurs lignes. J'ai bon ? L'autre possibilité, Nom et prénom, ne garantissant pas contre les homonymes.

Cordialement

KD

Cijoint.fr - Service gratuit de dépôt de fichiers

Cindy · 16 Mars 2011

Re : boucler sur les valeurs d'une colonne

Bonjour,

Quel travail!

Il y pour l'instant une anomalie. En effet, vers la fin du code avant "calcul colonne 23", le total des ST (en fait le total des degrés) doit se mettre en colonne 20 et non 19. La colonne 19 ne contient que le nombre de degrés correspondant aux vannages comme c'est bien écrit plus haut dans le code, le reste ne sont que des zéros.
De même, "total des ST + nombre de degrés" ne sert à rien.
Cette colonne 20 doit bien être arrondie comme écrit avant "formatage" mais peut-être que le code de cette ligne doit changer selon ce que je viens de vous dire...

Merci encore pour votre investissement!

KenDev · 16 Mars 2011

Re : boucler sur les valeurs d'une colonne

Bonjour Cindy,

Si tu n'as plus le fichier présent sur ci-joint en l'état, re télécharge le. Appuis juste sur le command bouton et corrige en rouge ce qui ne va pas, en indiquant les résultats attendus etc... (au besoin rajoute du texte sous le tableau ETAT généré) puis retransmet le fichier. Ce sera plus clair, la j'ai l'impression de lire du chinois. 🙂

Cordialement

KD

Effectuez une recherche sur Excel Downloads...

boucler sur les valeurs d'une colonne

Cindy

XLDnaute Nouveau

James007

XLDnaute Barbatruc

Cindy

XLDnaute Nouveau

KenDev

XLDnaute Impliqué

Cindy

XLDnaute Nouveau

KenDev

XLDnaute Impliqué

Cindy

XLDnaute Nouveau

KenDev

XLDnaute Impliqué

Cindy

XLDnaute Nouveau

Cindy

XLDnaute Nouveau

KenDev

XLDnaute Impliqué

Cindy

XLDnaute Nouveau

KenDev

XLDnaute Impliqué

Cindy

XLDnaute Nouveau

KenDev

XLDnaute Impliqué

Discussions similaires

Nous accordons de l'importance à votre vie privée