SUPER RESOLU - lignes de code répétitives

[Usine à gaz]

Bonjour à tous et à toutes

J'avais un soucis (comme d'hab) et camachepas (que je salue au passage) a eu la gentillesse de me donner un code que j'ai réussi (exploit LOL) à faire marcher.

Concernant ce code qui donc fonctionne super, j'ai un autre problème à vous soumettre.

En premier lieu, voici une partie du code :

Sub RdVgratuits()
 With Sheets("Données")
   If .Cells(3, 2) = Sheets("Facture").Cells(1, 1) Then .Range("M3") = Sheets("Facture").Range("AK72")
   If .Cells(4, 2) = Sheets("Facture").Cells(1, 1) Then .Range("M4") = Sheets("Facture").Range("Ak72")
   If .Cells(5, 2) = Sheets("Facture").Cells(1, 1) Then .Range("M5") = Sheets("Facture").Range("Ak72")
   If .Cells(6, 2) = Sheets("Facture").Cells(1, 1) Then .Range("M6") = Sheets("Facture").Range("Ak72")
   If .Cells(7, 2) = Sheets("Facture").Cells(1, 1) Then .Range("M7") = Sheets("Facture").Range("Ak72")
   If .Cells(8, 2) = Sheets("Facture").Cells(1, 1) Then .Range("M8") = Sheets("Facture").Range("Ak72")
   If .Cells(9, 2) = Sheets("Facture").Cells(1, 1) Then .Range("M9") = Sheets("Facture").Range("Ak72")
   If .Cells(10, 2) = Sheets("Facture").Cells(1, 1) Then .Range("M10") = Sheets("Facture").Range("Ak72")
  
 End With
End Sub

Comme vous le voyez, chaque ligne contient le même code, seuls changent les numéros de ligne et la ligne de la cellule : M
If .Cells(3, 2) et Range("M3")
If .Cells(4, 2) et Range("M4")
If .Cells(5, 2) et Range("M5") etc... et j'en ai jusqu'à 50 comme ça et ça augmente chaque jour ... donc, j'ajoute des lignes de code à chaque fois et ça devient long.

dans ma feuille "données", j'ai des plages nommées et l'idéal, je pense serait qu'au lieu d'avoir une ligne de code par ligne de la feuille données, la macro recherche "Sheets("Facture").Cells(1, 1)" dans la plage à laquelle j'ai donné le nom : "ClientsNo"

Mais voila, comme d'habitude, je me casse la tête et comme je suis toujours nul (un peu moins grâce à vous) .... je ne trouve pas.

En espérant m'être exprimé de manière compréhensible ......
Pourriez-vous m'aider ?
Un grand merci,
Amicalement,
Caliméro,

 

[ROGER2327]

Re : lignes de code répétitives

Bonjour arthour973.

On peut envisager des codes du genre​

Sub RdVgratuits()
Dim i&, ref, val
  ref = Sheets("Facture").Cells(1, 1).Value
  val = Sheets("Facture").Range("AK72").Value
  With Sheets("Données")
    For i = 3 To 10
      If .Cells(i, 2).Value = ref Then .Cells(i, "M").Value = val
    Next
  End With
End Sub

ou​

Sub RdVgratuits()
Dim i&, ref, val
  ref = Sheets("Facture").Cells(1, 1).Value
  val = Sheets("Facture").Range("AK72").Value
  With Sheets("Données").Cells(3, 2).Cells
    For i = 0 To 7
      If .Offset(i, 0).Value = ref Then .Offset(i, 11).Value = val
    Next
  End With
End Sub

Je n'ai pas testé faute de support.

À partir de là, on peut effectivement encore améliorer en utilisant des plages nommées. On verra ça lorsqu'on aura un support.​

Bonne journée.


ℝOGER2327
#7707

Mardi 17 Sable 142 (Saint Moyen, français - fête Suprême Quarte)
27 Frimaire An CCXXIII, 5,7900h - liége
2014-W51-3T13:53:46Z

 

[camarchepas]

Re : lignes de code répétitives

Bonjour Roger , Caliméro ,

Et oui sans fichier , pas évidant de tester , voici ma proposition pour tenir compte de ta liste nommée.
Y'a de la similitude avec la proposition de Roger ....

Sub RdVgratuit()
Dim Nb As Long, Tourne As Long

Nb = Range("ClientsNo").Count
With Sheets("Données")
 For Tourne = 3 To Nb
  If .Range("B" & Tourne) = Sheets("Facture").Range("A1") Then .Range("M" & Tourne) = Sheets("Facture").Range("AK72")
 Next Tourne
End With
End Sub

 

[job75]

Re : lignes de code répétitives

Bonjour arthour973,

Il faut savoir qu'en utilisant des tableaux VBA la recherche et la restitution sont extrêmement rapides.

Si la plage "ClientsNo" a toujours plus d'une cellule utilisez :

Sub RdVgratuits()
Dim t, t1, v, v1, i&
t = [ClientsNo] 'colonne B
t1 = [ClientsNo].Offset(, 11) 'colonne M
v = Sheets("Facture").[A1]
v1 = Sheets("Facture").[AK72]
For i = 1 To UBound(t)
  If t(i, 1) = v Then t1(i, 1) = v1
Next
[ClientsNo].Offset(, 11).Resize(UBound(t)) = t1
End Sub

S'il peut arriver que la plage "ClientsNo" n'ait qu'une seule cellule :

Sub RdVgratuits()
Dim t, t1, v, v1, i&
t = [ClientsNo] 'colonne B
t1 = [ClientsNo].Offset(, 11) 'colonne M
v = Sheets("Facture").[A1]
v1 = Sheets("Facture").[AK72]
If [ClientsNo].Count = 1 Then
  If t = v Then [ClientsNo].Offset(, 11) = v1
Else
  For i = 1 To UBound(t)
    If t(i, 1) = v Then t1(i, 1) = v1
  Next
  [ClientsNo].Offset(, 11).Resize(UBound(t)) = t1
End If
End Sub

Edit : hello Roger, camarchepas

A+

 

[Usine à gaz]

Re : lignes de code répétitives

Bonjour Job75,
Bonjour à tous et à toutes,

Vous êtes toujours plus rapide que l'éclair LOL,

Un grand merci ..... je teste et je reviens vers vous
Amicalement,
Caliméro,

 

[Usine à gaz]

Re : lignes de code répétitives

Bonjour camarchepas,

Y'avait trop longtemps,

Je crois que je vais poser plein de questions rien que pour avoir le plaisir de te parler ..

C'est vrai, je n'ai pas joins de fichier car mon classeur est gros et je n'ai pas eu le temps de faire un classeur test.
je vais tester et je reviens vers toi.

Si besoin est, je prendrai le temps de faire le fichier test.
Bonne fin de journée,
Amicalement,
Lionel (caliméro)

 

[Usine à gaz]

Re : lignes de code répétitives

Bonjour Roger 2327 (ça fait guerre des étoiles LOL)

Merci pour votre rapide retour .... vous êtes vraiment formidables)
C'est vrai, je n'ai pas mis de fichier car pas eu le temps de préparer un classeur test et mon classeur est très gros.

Je vais tester et je reviens vers vous
Merci à vous,
Amicalement,
Caliméro,

 

[Usine à gaz]

Re : lignes de code répétitives

Bonsoir Job75,
Bonsoir camarchepas
Bonsoir Roger .....
à toutes et à tous,

Votre code fonctionne super ..... en fait, comme vous l'avez vu, j'ai eu 4 codes et tous "marchent" à merveille.
Je ne les comprends pas mais je vais tenter de comprendre .... LOL

Merci et merci, grâce à vous, j'ai tellement pu automatiser mes classeurs de travail et cela m'a avantagé sur un tas de plans .... en fait, je peux travailler efficacement grâce à vous tous.

Encore merci
Lionel (Caliméro)