programmation boucle VBA

Version imprimable

08/03/2012, 16h12
olga33

1 pièce(s) jointe(s)

programmation boucle VBA

bonjour
afin d'éviter des copier/coller je me lance dans le Vba
je tourne en rond avec les boucles ..
voici mon fichier Merci de votre aide
08/03/2012, 17h34
Philippe Tulliez

Bonjour,
Par contre au lieu de placer un fichier, n'hésites surtout pas à Copier/coller le code qui te pose un problème en expliquant clairement ce qui ne vas pas. La ligne où cela plante etc...

Bonjour,

Mets la macro suivante dans un module standard et exécute-la :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub test()
    Dim UE() As String, Ctr As Integer, c As Range, Sh As Worksheet, Nom
    Dim x As Range
    With Sheets("CANDIDATS")
        Ctr = -1
        For Each c In .Range(.[C2], .Cells(.Rows.Count, 3).End(xlUp))
            If c.Value = "x" Then
                Ctr = Ctr + 1
                ReDim Preserve UE(Ctr)
                UE(Ctr) = c.Offset(, -1)
            End If
        Next c
    End With
    With Sheets("PREVISIONNEL")
        For Each c In .[C7:AN37]
            For Each Nom In Array("DCG 1", "DCG 2", "DCG 3")
                Set Sh = Sheets(Nom)
                If Left(Sh.Range(c.Address).Value, 2) = "UE" Then
                    If IsNumeric(Application.Match(Sh.Range(c.Address), UE, 0)) Then
                        If c.Value <> "" Then
                            c.Value = "err"
                        Else
                            c.Value = Sh.Range(c.Address).Value
                        End If
                    End If
                End If
            Next Nom
        Next c
    End With
End Sub

... ou, un peu plus rationnel :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub test()
    Dim UE() As String, Ctr As Integer, c As Range, Sh As Worksheet, Nom
    Dim x As Range
    With Sheets("CANDIDATS")
        Ctr = -1
        For Each c In .Range(.[C2], .Cells(.Rows.Count, 3).End(xlUp))
            If c.Value = "x" Then
                Ctr = Ctr + 1
                ReDim Preserve UE(Ctr)
                UE(Ctr) = c.Offset(, -1)
            End If
        Next c
    End With
    With Sheets("PREVISIONNEL")
        For Each c In .[C7:AN37]
            For Each Sh In Sheets(Array("DCG 1", "DCG 2", "DCG 3"))
                If Left(Sh.Range(c.Address).Value, 2) = "UE" Then
                    If IsNumeric(Application.Match(Sh.Range(c.Address), UE, 0)) Then
                        If c.Value <> "" Then
                            c.Value = "err"
                        Else
                            c.Value = Sh.Range(c.Address).Value
                        End If
                    End If
                End If
            Next Sh
        Next c
    End With
End Sub

12/03/2012, 12h41
olga33

remerciements

bonjour
en fait avec mon petit code il me manquait toujours une UE
soit je bouclais mal soit je devait l'écraser soit je ne lisais pas les données
mais le pire c'est que je ne voyais rien même avec la touche F8
mais
Haou!! j'ai encore beaucoup a apprendre, je vais faire un tour du côté des tutos et me connecter plus souvent
encore merci
12/03/2012, 12h47
Daniel.C

Bonjour,

Merci du retour. N'hésite pas à demander des explications sur ce que tu ne comprends pas.