Problème d'égalité de variables ?

Version imprimable

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:

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:

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

12/04/2014, 18h23
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 !
12/04/2014, 20h19
lucasflorent

1 pièce(s) jointe(s)

Avec fichier exemple

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
12/04/2014, 20h24
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 …

Bonsoir,

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

Code:

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

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:

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

14/04/2014, 11h06
casefayere

Citation:

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