Création d'une boucle
Passionné d'excel
Bonjour,
J'essaye de créer une boucle pour remplir des cellules je n'y arrive pas
La procédure est celle-ci :
Private Sub CommandButton66_Click()
Range(Sheets("Materiels").Range("B:B").Find(fnummat.Value, LookIn:=xlValues).Address).Select 'cellule qui sera point de départ
ActiveCell.Offset(0, 45).select ' cellule de départ + 45
If ActiveCell.value = "" Then 'si la cellule active + 45 (même ligne) est vide alors
ActiveCell.value =fesp.value ' valeur d'un textbox
etc...
end ifc'est ici que j'ai besoin de la boucle
If ActiveCell.value <> "" Then 'si la cellule active + 45 (même ligne) n'est pas vide alors
il faut qu'il trouve la première cellule avec un offset(0,23) (teste à chaque fois si la 23e est vide pour y mettre les valeurs
ci-joint un fichier pour comprendre et tester
Merci d'avance à ceux qui vont m'aider
Amicalement
Merci gmb
C'est absolument parfait
Encore, un grand merci à toi
Désolé de forcer sur les smileys mais je suis
gmb
ou quelqu'un qui a pitié
j'ai encore besoin d'aide s'il vous plait
gmb ton code est bien MAIS je constate un problème (ou c'est moi qui a mal entré les lignes de code)
lecode fonctionne bien seulement 2 fois (dans mon projet ça peut aller jusqu'à +400 fois)
3ème fois la première valeur est bien placée et le reste il y a décalage de 1
4ème fois la première valeur est bien placée et le reste il y a décalage de 2
etc...
J'ai essayé pendant des heures à éviter ce décalage, SANS SUCCÈS
Peux-tu s'il te plait gmb ou pouvez-vous s'il vous plait voir ce qu'il peux être fait pour que tout fonctionne bien à chaque fois que je lance le boutton ?
Un grand merci d'avance
Ci dessous mon code complet
et j'ai reproduis l'erreur dans le fichier ci-joint
le code en entier est celui-ci
Private Sub fbloc1_Click()
If fnummat = "" Then
MsgBox "Vous devez indiquer un numéro de matériel"
Exit Sub
End If
If Sheets("Materiels").Range("D:D").Find(fnummat.Value, LookIn:=xlValues) Is Nothing Then
MsgBox "Le matériel " & fnummat & " n'a pas été trouvée"
Exit Sub
End If
on Error resume next
Set Cell = Range(Sheets("Materiels").Range("D:D").Find(fnummat.Value, LookIn:=xlValues).Address) '.Select
Set Cell = Cell.Offset(0, 48)
'If ActiveCell.Value = "" Then
i = 0
If Cell.Value = "" Then
'ActiveCell.Value = "test" ' valeur d'un textbox
Cell.Value = fnumloc.Value
Cell.Offset(0, 1).Value = Format(fdate, "mm/dd/yyyy")
Cell.Offset(0, 2).Value = Format(fdatefin, "mm/dd/yyyy")
Cell.Offset(0, 3).Value = Format(fdatefin, "mm/dd/yyyy")
Cell.Offset(0, 4).Value = fnumclient.Text
Cell.Offset(0, 5).Value = fclient.Text
Cell.Offset(0, 6).Value = fadresse.Text
Cell.Offset(0, 7).Value = fville.Text
Cell.Offset(0, 8).Value = fpro.Text 'le 8 parenthèse doit correspondre à un smileys ?
Cell.Offset(0, 9).Value = fnumop.Text
Cell.Offset(0, 10).Value = fcontact.Text
Cell.Offset(0, 11).Value = ftel.Text
Cell.Offset(0, 12).Value = fmail.Text
'cell.Offset(0, 13).Value = libre.Text
On Error Resume Next
If nbj1 <> "" Then
Cell.Offset(0, 14) = "Jours"
Cell.Offset(0, 15) = nbj1.Text
Cell.Offset(0, 16) = CDbl(pj1)
ElseIf nbwe1 <> "" Then
Cell.Offset(0, 14) = "Week end"
Cell.Offset(0, 15) = nbwe1.Text
Cell.Offset(0, 16) = CDbl(pwe1)
ElseIf nbs1 <> "" Then
Cell.Offset(0, 14) = "Semaine"
Cell.Offset(0, 15) = nbs1.Text
Cell.Offset(0, 16) = CDbl(ps1)
ElseIf nbm1 <> "" Then
Cell.Offset(0, 14) = "Mois"
Cell.Offset(0, 15) = nbm1.Text
Cell.Offset(0, 16) = CDbl(pm1)
End If
Cell.Offset(0, 17) = ctva1.Text
If ctva1 = 1 Then
Cell.Offset(0, 18) = CDbl(ttva1)
Cell.Offset(0, 19) = CDbl(qvt1)
ElseIf ctva1 = 2 Then
Cell.Offset(0, 18) = CDbl(ttva2)
Cell.Offset(0, 19) = CDbl(cen1)
End If
Cell.Offset(0, 20) = cent1.Text
Cell.Offset(0, 21) = CDbl(mcent1)
Cell.Offset(0, 22) = CDbl(net1)
Cell.Offset(0, 23) = CDbl(caut1)
Cell.Offset(0, 24) = op1.Text
Cell.Offset(0, 25) = CDbl(tot1)
Cell.Offset(0, 26) = CDbl(ConversE(tot1) + ConversE(qvt1) + ConversE(cen1))
'cell.Offset(0, 27) = libre
Cell.Offset(0, 28) = fnumdevis.Text
Cell.Offset(0, 29) = fnumfacture.Value
Else
Do While Cell.Offset(0, 39 * (i + 1)).Value <> ""
i = i + 1
Loop
Cell.Offset(0, 39 * (i + 1)) = fnumloc.Value
Cell.Offset(0, 40 * (i + 1)) = Format(fdate, "mm/dd/yyyy")
Cell.Offset(0, 41 * (i + 1)) = Format(fdatedeb, "mm/dd/yyyy")
Cell.Offset(0, 42 * (i + 1)) = Format(fdatefin, "mm/dd/yyyy")
Cell.Offset(0, 43 * (i + 1)) = fnumclient.Text
Cell.Offset(0, 44 * (i + 1)) = fclient.Text
Cell.Offset(0, 45 * (i + 1)) = fadresse.Text
Cell.Offset(0, 46 * (i + 1)) = fville.Text
Cell.Offset(0, 47 * (i + 1)) = fpro.Text
Cell.Offset(0, 48 * (i + 1)) = fnumop.Text
Cell.Offset(0, 49 * (i + 1)) = fcontact.Text
Cell.Offset(0, 50 * (i + 1)) = ftel.Text
Cell.Offset(0, 51 * (i + 1)) = fmail.Text
'cell.Offset(0, 52* (i + 1)) = libre.Text
If nbj1 <> "" Then
Cell.Offset(0, 53 * (i + 1)) = "Jours"
Cell.Offset(0, 54 * (i + 1)) = nbj1.Text
Cell.Offset(0, 55 * (i + 1)) = CDbl(pj1)
ElseIf nbwe1 <> "" Then
Cell.Offset(0, 53 * (i + 1)) = "Week end"
Cell.Offset(0, 54 * (i + 1)) = nbwe1.Text
Cell.Offset(0, 55 * (i + 1)) = CDbl(pwe1)
ElseIf nbs1 <> "" Then
Cell.Offset(0, 53 * (i + 1)) = "Semaine"
Cell.Offset(0, 54 * (i + 1)) = nbs1.Text
Cell.Offset(0, 55 * (i + 1)) = CDbl(ps1)
ElseIf nbm1 <> "" Then
Cell.Offset(0, 53 * (i + 1)) = "Mois"
Cell.Offset(0, 54 * (i + 1)) = nbm1.Text
Cell.Offset(0, 55 * (i + 1)) = CDbl(pm1)
End If
Cell.Offset(0, 56 * (i + 1)) = ctva1.Text
If ctva1 = 1 Then
Cell.Offset(0, 57 * (i + 1)) = CDbl(ttva1)
Cell.Offset(0, 58 * (i + 1)) = CDbl(qvt1)
ElseIf ctva1 = 2 Then
Cell.Offset(0, 57 * (i + 1)) = CDbl(ttva2)
Cell.Offset(0, 58 * (i + 1)) = CDbl(cen1)
End If
Cell.Offset(0, 59 * (i + 1)) = cent1.Text
Cell.Offset(0, 60 * (i + 1)) = CDbl(mcent1)
Cell.Offset(0, 61 * (i + 1)) = CDbl(net1)
Cell.Offset(0, 62 * (i + 1)) = CDbl(caut1)
Cell.Offset(0, 63 * (i + 1)) = op1.Text
Cell.Offset(0, 64 * (i + 1)) = CDbl(tot1)
Cell.Offset(0, 65 * (i + 1)) = CDbl(ConversE(tot1) + ConversE(qvt1) + ConversE(cen1))
'cell.Offset(0, 66* (i + 1)) = libre
Cell.Offset(0, 67 * (i + 1)) = fnumdevis.Text
Cell.Offset(0, 68 * (i + 1)) = fnumfacture.Value
'cell.Offset(0, 69* (i + 1)) = flibrea1.Text
'cell.Offset(0, 70* (i + 1)) = flibreb1.Text
'cell.Offset(0, 71* (i + 1)) = flibrec1.Text
'cell.Offset(0, 72* (i + 1)) = flibred1.Text
'cell.Offset(0, 73* (i + 1)) = fvidea1.Text
'cell.Offset(0, 74* (i + 1)) = fvideb1.Text
'cell.Offset(0, 75* (i + 1)) = fvidec1.Text
'cell.Offset(0, 76* (i + 1)) = fvideb1.Text
'cell.Offset(0, 77* (i + 1)) = fvidec1.Text
End If
floc1 = 1
End Sub
Bonjour
nicaise a écrit :Peux-tu s'il te plait gmb ou pouvez-vous s'il vous plait voir ce qu'il peux être fait pour que tout fonctionne bien à chaque fois que je lance le boutton ?
Je viens de réessayer et tout me semble bien marcher.
Mais au lieu de joindre ta macro adaptée, qui est longue comme un jour sans pain, il me serait plus utile que tu joingnes un fichier avec ta feuille de départ et une feuille représentant ce qu’elle doit devenir après le lancement de la macro.
A te relire.
Bye !
Bonjour,
gmb
?? Je viens de réessayer et tout me semble bien marcher ??
Bizarre !
Regarde le fichier
boucle_svp v1-décalage.xlsm
il provoque les décalages à partir de la 3e fois
c'est ton code, je n'ai rien touché
dans mon projet ça fait exactement la même chose
Après loop comment écrire les cellules de destination pour qu'il n'y ai pas de décalage à un moment donné
nicaise a écrit :Regarde le fichier boucle_svp v1-décalage.xlsm
Je viens de tester une nouvelle fois et, quand je clique
* une premières fois, en AW on a écrit : ‘’Test 1’’
*une deuxième fois, en BT on a écrit : ‘’Test 1’’
* une troisième fois, en CQ on a écrit : ‘’Test 2’’
* une quatrième fois, en DN on a écrit : ‘’Test 3’’
* une cinquième fois, en EK on a écrit : ‘’Test 4’’
Et chaque fois, le texte est bien juste avant la colonne ‘’Date’’
Maintenant, si quand tu parles de décalage tu veux parler de ‘’Test 1’’ qui se répète 2 fois, je te joins cette nouvelle version qui commence bien à Test 1 et se poursuit en suivant, sans répétition…
OK ?
gmb merci pour ta réponse
je crois que l'on ne s'est pas bien compris
Comme je l'ai toujours dis dans tous mes messages, la première valeur se met effectivement toujours au bon endroit,
MAIS c'est tout le reste qui vient après (car il n'y a pas qu'une valeur mais une vingtaine après qui doivent être mises.
S'il te plaît regarde mon fichier boucle_svp v1-décalage.xlsm, tu verras tout de suite, le souci.
Regarde et clique sur le bouton tu verras tout de suite que le décalage se poursuit.
Merci de regarder mon fichier
nicaise a écrit :regarde mon fichier boucle_svp v1-décalage.xlsm
Je viens de le faire et je constate que les "numlock " s'écrivent bien là où ma macro écrit "Test". En revanche il y a d'autres valeurs comme "dateauj" et "date demain" qui se décalent.
Mais ce n'est pas ma macro qui fait ça.
Si tu veux écrire d'autres valeurs à la suite de" numlock" ("Test" pour ma macro), prend modèle sur cette nouvelle version :
Bonjour gmb
Jai testé la nouvelle version
et enfin ça marche super bien
toutes les valeurs après loop se mettent au bon endroit et qu'importe le nombre de procédure
tu es un chef
Merci beaucoup je vais pouvoir avancer dans mon projet maintenant