Probleme boucle FOR
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 (
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
Merci d'avance
Olivier
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+