Probleme boucle FOR

Le 23/01/2017 à 13:18

Bonjour à tous. Je me permets de revenir vers vous, car vous m'aviez été d'un grand secoure il y a quelques temps.

Je travail aujourd'hui sur ce code

Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Sub Bouton2_Clic()
Application.ScreenUpdating = False

Dim lpBuff As String * 25
Dim retour As Long
Dim utilisateur As String
Dim y As Date

Dim GlsWinExpe6 As String
Dim b As Integer
Dim g As Integer
Dim h As Integer
Dim Chemin As String
Dim Part As String
Dim Chem2 As String

retour = GetUserName(lpBuff, 25)
utilisateur = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)

y = DatePart("yyyy", Date, vbMonday, vbFirstFourDays)

'
Chemin = "C:\Users\" & utilisateur & "\Desktop\"
Part = GlsWinExpe6
Chem2 = Dir(Chemin & Part & "*.xls")

' Ouverture du fichier
 Workbooks.Open Filename:=Chemin & Chem2, Local:=True
Columns("F:F").Select
    Selection.NumberFormat = "0"
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

' modification des AFR

Dim a As Long
a = Range("F" & Rows.Count).End(xlUp).Row

For b = 1 To a

If Left(Cells(b, 6), 3) = "AFR" Then
Cells(b, 6).Replace "AFR0", ""
Cells(b, 6).Value = Left(Cells(b, 6).Value, Len(Cells(b, 6).Value) - 3)
End If
Next b

' copies des données sur suivi cdes jantes
Dim e As Long
e = Range("F" & Rows.Count).End(xlDown).Row
Application.CutCopyMode = False
Range(Cells(2, 6), Cells(e, 6)).Copy
Workbooks("Suivi cdes jantes.xlsm").Activate
Sheets("Feuil1").Activate
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues

Workbooks(Chem2).Activate
Dim f As Long
f = Range("R" & Rows.Count).End(xlDown).Row
Application.CutCopyMode = False
Range(Cells(2, 18), Cells(f, 18)).Copy
Workbooks("Suivi cdes jantes.xlsm").Activate
Sheets("Feuil1").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues

'analyse des n° de commande pour trouver le trackID

Dim index As Long
index = Sheets("Feuil1").index
Sheets(index - 1).Activate

Dim c As Variant
Dim d As Variant
c = Range("B" & Rows.Count).End(xlUp).Row
d = Range("E" & Rows.Count).End(xlUp).Row

If Range("E4") = "" Then

For g = d + 3 To c
Application.CutCopyMode = False
Cells(g, 2).Copy
Sheets("Feuil1").Activate
Cells(3, 1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Cells(4, 1).Copy
Sheets(index - 1).Activate
Cells(g, 5).Select
Application.ScreenUpdating = True
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.ScreenUpdating = False
Next g

Else

For h = d To c
Application.CutCopyMode = False
Cells(h, 2).Copy
Sheets("Feuil1").Activate
Cells(3, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Cells(4, 1).Copy
Sheets(index - 1).Activate
Cells(h, 5).Select
Application.ScreenUpdating = True
Selection.PasteSpecial Paste:=xlPasteValues
Application.ScreenUpdating = False

Next h

End If

'analyse des doublons
Dim Plage As Range
    Dim Cel As Range

    With Worksheets(index - 1)

       Set Plage = .Range(.Cells(4, 5), .Cells(.Rows.Count, 5).End(xlUp))

    End With

   For Each Cel In Plage

        If Application.CountIf(Plage, Cel.Value) > 1 Then
        If Not Cel.Value = "" Then

            MsgBox "Attention, la valeur '" & Cel.Value & "' est en doublon," _
                   & " Merci de vérifié le Track ID situé en  '" & Cel.Address(0, 0) _

            Cel.Interior.ColorIndex = 3

        End If
        End If

    Next Cel

Sheets("Feuil1").Activate
Dim i As Long
i = Range("B" & Rows.Count).End(xlUp).Row
Range(Cells(4, 2), Cells(i, 3)).ClearContents

Workbooks(Chem2).Close Savechanges:=False

Sheets(index - 1).Activate
End Sub

Hormis que ce code doit être mal fichu ( ) , mon problème viens de cette partie

index As Long
index = Sheets("Feuil1").index
Sheets(index - 1).Activate

Dim c As Variant
Dim d As Variant
c = Range("B" & Rows.Count).End(xlUp).Row
d = Range("E" & Rows.Count).End(xlUp).Row

If Range("E4") = "" Then

For g = d + 3 To c
Application.CutCopyMode = False
Cells(g, 2).Copy
Sheets("Feuil1").Activate
Cells(3, 1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Cells(4, 1).Copy
Sheets(index - 1).Activate
Cells(g, 5).Select
Application.ScreenUpdating = True
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.ScreenUpdating = False
Next g

Else

For h = d To c
Application.CutCopyMode = False
Cells(h, 2).Copy
Sheets("Feuil1").Activate
Cells(3, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Cells(4, 1).Copy
Sheets(index - 1).Activate
Cells(h, 5).Select
Application.ScreenUpdating = True
Selection.PasteSpecial Paste:=xlPasteValues
Application.ScreenUpdating = False

Next h

End If

lorsque j'essai de faire fonctionner mon code dans mon fichier de travail, il ne s'exécute pas (toute la partie supérieur s'exécute sans soucis). Aucun message d'erreur n'apparait.

Cependant, lorsque j'exécute ce bout de code sur un nouveau fichier test, tout fonctionne correctement.

Quand j'utilise le Pas à Pas, je m'aperçois qu'il décent bien jusqu'au

For g = d + 3 To c

mais qu'il passe directement au End if, sans même tenter de faire la boucle.

Sur ce point je sèche complètement Des idées ?

Merci d'avance

Olivier

Le 23/01/2017 à 14:54

bonjour,

... parce que d+3 est plus grand que c ?

Quand tu es au point d'arrêt (en mode débogage), tu peux lire la valeur de tes variables en les survolant avec la souris.

A+

Rechercher des sujets similaires à "probleme boucle"