Discussion :

[lucasflorent]

Bonjour tout le monde,

Je suis en train de rédiger un petit script tout bête mais je suis confronté à un problème nouveau pour moi :

J'ai une colonne A possédant des nombres (code de postes) rangés dans l'ordre croissant mais qui ne se suivent pas forcément et qui peuvent être en double voire triple (ex. : 7, 9, 15, 15, 18, 19, 20, 20, 20, 35, 39, ...). Les nombres de la colonne A sont appareillés avec les nombres de la colonne B (barème pour chaque poste en l’occurrence) situés sur les mêmes lignes.

Je veux obtenir deux nouvelles colonnes (D et E) qu reprendraient toutes ces paires de nombres mais qui intercaleraient les codes postes manquants (nombres de la colonne A) pour obtenir une liste de 1 à 6000 dans la colonne D et le premier barème correspondant à chaque code poste lorsqu'il existe dans la colonne E...

Voici le code rédigé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
Sub ajoutManquant()
 
    Dim CodePoste As Integer
    Dim NumLigneCode As Integer
    Dim j As Integer
    Dim b As Integer
 
    CodePoste = 1
    NumLigneCode = 2
    j = 2
    b = 0
 
lign0:
 
        If Cells(j, 1) = CodePoste Then
            'Debug.Print "OK"
            Cells(NumLigneCode, 4) = Cells(j, 1)
            Cells(NumLigneCode, 5) = Cells(j, 2)
            b = j + 1
        Else
            Cells(NumLigneCode, 4) = CodePoste
            Cells(NumLigneCode, 5) = ""
        End If
 
        If Cells(j, 1) = Cells(j + 1, 1) Then
            b = j + 2
        End If
 
        If Cells(j, 1) = Cells(j + 2, 1) Then
            b = j + 3
        End If
 
        NumLigneCode = NumLigneCode + 1
        CodePoste = CodePoste + 1
        j = b
 
        'Debug.Print "Cell=" & Cells(j, 1) & " / Code=" & CodePoste & " / NumLign=" & NumLigneCode & " / j=" & j
 
        If CodePoste = 6000 Then Exit Sub
 
        GoTo lign0
 
End Sub

Là où ça devient étrange, c'est que VBA m'indique une erreur 1004 "définie par l'application ou par l'objet" et que cette erreur semble venir de la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

j=b

puisque lorsque je supprime cette ligne, il n'y a plus d'erreur. Si je remplace j=b par j=1 ou j=NumLigneCode (ce qui ne sert à rien mais c'est simplement pour essayer), il n'y a plus d'erreur.

Quelqu'un a-t-il une idée du pourquoi ?

Merci d'avance,

Florent Lucas

[jijie]

Bonsoir,


Désolé, mais je ne comprends pas trop, tu pourrais montré soit par un fichier excel ou en image ce que tu voudrais?

sans avoir regardé, les "Goto" pas Top !

[lucasflorent]

Bonsoir Jijie,

Merci pour ton aide.
Je te joins un exemple de mes colonnes A et B ainsi que ce que souhaite obtenir (colonnes D et E).
En ce qui concerne le goto, je sais que c'est moyen mais c'est codé rapidement et j'essaye plus de comprendre pourquoi vba me refuse j=b ...
Merci encore,

Florent LUCAS

[Marc-L]

Bonjour, bonjour,

l'erreur ne provient pas de cette ligne.
Pour trouver la ligne la déclenchant, suivre la progression du code en mode pas à pas via la touche F8 …

Indirectement si …

Si j = b et b est égal à zéro alors que se passe-t-il en début de "boucle" ? C'est quoi la logique ? A revoir donc …

[casefayere]

Bonsoir,

Voilà comment je vois les choses, d'après le fichier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub ajoutManquant()
Dim TbOrigine, Derlg As Range, TbFinal(), x As Long, y As Long
With Sheets("Recap Proper")
  Set Derlg = .Range("A" & .Rows.Count).End(xlUp)
  TbOrigine = .Range("A2", Derlg(1, 2))
  ReDim TbFinal(1 To Derlg, 1 To 2)
  y = 1
  For x = 1 To Derlg
    If TbOrigine(y, 1) > x Then
      TbFinal(x, 1) = x
    Else
      TbFinal(x, 1) = TbOrigine(y, 1)
      TbFinal(x, 2) = TbOrigine(y, 2)
      y = y + 1
    End If
  Next x
  Set Derlg = .Range("D" & .Rows.Count).End(xlUp)(1, 2)
  If Derlg.Row > 1 Then .Range("D2", Derlg).ClearContents
  .Range("D2").Resize(UBound(TbFinal, 1), UBound(TbFinal, 2)) = TbFinal
End With
End Sub

[Docmarti]

Bonjour Florent. Tous.

Avec votre permission, je proposerais cette solution:

EDIT: Merci casefayere de ton accueil.

EDIT: Ajout d'une routine de vérification de la croissance du résultat : Croissance 0 ou 1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 
Sub GB_002()
 
    Dim debut As Long
    Dim f As Worksheet
    Dim DernierL As Long
    Dim LigneDest  As Long
    Dim i As Long
    Dim a As Variant
    Dim precedent As Variant
 
    Set f = ActiveSheet
 
     Set rg = f.Range("A:A").Find(what:="*", After:=f.[A1], LookIn:=xlValues, LookAt:=xlPart, SearchFormat:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
     If rg Is Nothing Then DernierL = 1 Else DernierL = rg.Row
 
    f.Range("J:K").Clear
 
    LigneDest = 2
    debut = 0
    For i = 2 To DernierL
 
        a = f.Cells(i, "A").Value
 
        If a = "" Then Stop
 
        If Val(a) = debut Then
 
            f.Cells(LigneDest, "J") = f.Cells(i, "A")
            Call Verifie(precedent, f.Cells(LigneDest, "J"))
                precedent = f.Cells(LigneDest, "J")
 
            f.Cells(LigneDest, "K") = f.Cells(i, "B")
            LigneDest = LigneDest + 1
 
        ElseIf a > debut Then
            While debut < a - 1
                debut = debut + 1
                f.Cells(LigneDest, "J") = debut
                Call Verifie(precedent, f.Cells(LigneDest, "J"))
                precedent = f.Cells(LigneDest, "J")
                LigneDest = LigneDest + 1
            Wend
 
            f.Cells(LigneDest, "J") = f.Cells(i, "A")
            Call Verifie(precedent, f.Cells(LigneDest, "J"))
                precedent = f.Cells(LigneDest, "J")
            debut = f.Cells(i, "A")
            f.Cells(LigneDest, "K") = f.Cells(i, "B")
            LigneDest = LigneDest + 1
 
        Else
        'If a < debut
            f.Cells(i, "A").Select
            MsgBox "erreur sur la ligne " & i
            Stop
 
        End If
 
    Next
    While debut < 6000
                debut = debut + 1
                f.Cells(LigneDest, "J") = debut
                Call Verifie(precedent, f.Cells(LigneDest, "J"))
                precedent = f.Cells(LigneDest, "J")
                LigneDest = LigneDest + 1
            Wend
     f.Activate
     f.Cells(LigneDest, "J").Select
 
 
End Sub
 
Sub Verifie(precedent, r As Range)
    If Not IsEmpty(precedent) And Not (r = precedent Or r - precedent = 1) Then
          r.Parent.Activate
          r.Select
          MsgBox "Erreur en " & r.Address
          Stop
  End If
End Sub

[casefayere]

Avec votre permission, je proposerais cette solution:

Je n'ai pas analysé ton code, Docmarti, mais tu n'as pas besoin de permission, plusieurs idées valent mieux qu'une.

Bonne journée