VBA Mise à jour auto de liste de prix

[Résolu/Fermé]
Signaler
Messages postés
12
Date d'inscription
jeudi 29 janvier 2009
Statut
Membre
Dernière intervention
2 mars 2009
-
Messages postés
12
Date d'inscription
jeudi 29 janvier 2009
Statut
Membre
Dernière intervention
2 mars 2009
-
Bonjour à tous !

j'ai un petit soucis. J'ai un code qui fonctionne (c'est pas le plus optimisé mais voila..) mais il a des bug !

je vous explique. J'ai un liste de prix nommé "listes_a_parcourir.XLS" avec mes prix de mon système de facturation.

J'ai des nouveaux prix a mettre à jours.

j'ai donc un fichier qui s'appelle source_a_chercher.XLS avec mes nouveaux prix et des références.

Il doit donc ouvrire le fichier a mettre à jour et prendre chaque ligne de "source_a_chercher" et chercher dans la listes_a_parcourir.XLS et mettre a jour les prix qu'il trouve (avec le numéro de référence).

Mon code fonctionne mais des fois il me marque pas les prix au bons endroit. une des valeurs ou qqch ne doit pas être juste, mais je ne trouve pas quoi !!

si qqn peux m'aider ! merci beaucoup !

Bon Week-end !

Salutations

Sub Start_update()
' Calcul le nomdre de ligne de données
NbLignes = ActiveSheet.UsedRange.Rows.Count - 2
varcount = 1
Dim var_i_ref As Integer, var_i_ref_string As String, Nbsheet As Integer, I As Integer, SheetFrom As Integer, SheetTo As Integer, sheerpos As Integer

' on ouvre le fichier a updater
Workbooks.Open Filename:= _
"C:\listes_a_parcourir.XLS", _
Editable:=True

' START BOUCLE

For RowCount = 2 To 202
varcount = varcount + 1
Windows("source_a_chercher.XLS").Activate
varNumeroREF = Range("A" & varcount).Value ' Numero a chercher
varID_ADB = Range("F" & varcount).Value ' ID lieferant
varPreisVK = Range("H" & varcount).Value ' VK preis
varPdatum = "Feb. 09" ' DATUM der PREISLISTE

' on marque dans la liste a chercher dans la dernière colone le résultat.
Cells(varcount, "J").Value = "Oki !" ' ON CONFIRME LE TRAVAIL
Cells(varcount, "K").Value = "n/a" ' COMMENTAIRE DU PRODUIT

' on active le fichier ou il faut chercher
Windows("listes_a_parcourir.XLS").Activate

' ON LIMITE LES FEUILLES
SheetFrom = 19
SheetTo = 26
Sheetpos = SheetFrom - 1
'

While Sheetpos <= SheetTo 'Parcourir les feuille de x à x selon nos souhaits
Sheetpos = Sheetpos + 1 'on incremente
If Not (varNumeroREF = "") Then 'si le numéro de réf n'est pas vide
With Worksheets(Sheetpos).Range("O1:O1000") ' on cherche dans la bonne colone
Set c = .Find(varNumeroREF)
If Not c Is Nothing Then
firstAddress = c.Address
Do
' On cherche la référence de la ligne
Dim i2 As Integer
i2 = 0
var_is_dif = 3
var_i_ref = 0
For i2 = 1 To Len(c.Address)
If (Mid(c.Address, i2, 1) >= "0" And Mid(c.Address, i2, 1) <= "9") Then
var_i_ref = var_i_ref & Mid(c.Address, i2, 1)
End If
Next i2
' ligne trouvée / on écrit les valeurs
' SET Ref fournissuer
If (var_i_ref > 1) Then
Range("P" & var_i_ref).Select
var_ref_fournisseur_old = ActiveCell.Value ' on recupere la vielle valeur
ActiveCell.FormulaR1C1 = varID_ADB
'MsgBox var_ref_fournisseur
' SET PRIX
Range("K" & var_i_ref).Select
ActiveCell.FormulaR1C1 = varPreisVK
' SET Date update
Range("R" & var_i_ref).Select
ActiveCell.FormulaR1C1 = varPdatum

' MsgBox (var_i_ref)on copie la ref fournisseur dans la colone V
Range("V" & var_i_ref).Select
ActiveCell.FormulaR1C1 = var_ref_fournisseur_old

' et on la colorie en jaune ou rouge (jaune ref = / Rouge si <>)
If (var_ref_fournisseur_old = varID_ADB) Then
Range("V" & var_i_ref).Select
With Selection.Interior
.ColorIndex = 6 ' jaune
.Pattern = xlSolid
End With
var_is_dif = 0
Else
Range("V" & var_i_ref).Select
With Selection.Interior
.ColorIndex = 3 ' rouge
.Pattern = xlSolid
End With
var_is_dif = 1
Sheetpos = SheetTo + 1
End If
'MsgBox (var_i_ref)

End If


' on retourne sur la liste de prix et on note que l'on à fait
Windows("source_a_chercher.XLS").Activate
If (var_is_dif = 0) Then
Cells(varcount, "K").Value = "Trouvé à l'adresse " & c.Address & " et Réf produit correspond! "
End If
If (var_is_dif = 1) Then
Cells(varcount, "K").Value = "Trouvé à l'adresse " & c.Address & " mais à VERIFIER SVP !!! "
End If


'on retourne sur les prix
Windows("listes_a_parcourir.XLS").Activate

'End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End If

Wend

Next RowCount

With Assistant.NewBalloon
.BalloonType = msoBalloonTypeNumbers
.Icon = msoIconTip
.Button = msoButtonSetOK
.Heading = "Bravo !"
.Labels(1).Text = "La procédure est terminée !"
.Show
End With

'
End Sub

5 réponses


Bonjour,
As-tu esayé en mode pas à pas détaillé pour voir ou cela plante ?
Messages postés
12
Date d'inscription
jeudi 29 janvier 2009
Statut
Membre
Dernière intervention
2 mars 2009

Hello Carpediem,

Oui j'ai essayé mais je ne voit vraiment pas ou cela bug !

Certaines références sont justes mais d'un coup dans ma liste de prix ya des nouveau prix marqué sur des lignes vides.

du coup je ne comprend pas !

Merci pour l'aide

Marcolino

Bonjour,
J'ai bien lu que ton code fonctionne mais que parfois moins bien qu'attendu : qualité du prix renvoyé !
Vérifie si tes "reférences" (seul lien entre les deux fichiers) sont bien au même format dans les deux fichiers, et si, par hasard tu n'aurais pas des doublons dans l'un ou l'autre, ton itération pourrait alors renvoyer la derniére valeur (donc pas la premiére que tu vois sur une recherche purement visuelle ou pire en recherchev.
Je vois certaine valeur fixe rowcount 2 to 202, la plage est-elle suffisante ?
Aux endroits défectueux dans lsite a parcourir, quel message correspond dans source a chercher :"et ref produit correspond" ou l'autre ?
Messages postés
12
Date d'inscription
jeudi 29 janvier 2009
Statut
Membre
Dernière intervention
2 mars 2009

Hello cocotehier,

merci pour ta réponse.

mes formats sont pareils et je n'ai pas de doublons.

et ce qui est vraiment bizard, c'est qu'il met à jour des prix même dans certaines lignes ou il y avait pas de prix.

Donc à la fin du fichier, il y a espacé de chaque fois 3-4 lignes des prix mais sans références !

comme si il trouvait qqch sur la ligne dans le références mais il y a rien (même caché rien..)

merci pour l'aide
Messages postés
12
Date d'inscription
jeudi 29 janvier 2009
Statut
Membre
Dernière intervention
2 mars 2009

hello à tous.

C'est bon j'ai trouvé ! J'était tellement concentré sur la recherche d'erreur de référence que j'ai pas vus qu'il y avait une erreur dans la reference de la feuille et non de la celule.. donc c'est reglé !

merci a tous !

salutations