XL 2013 [Résolu] Dupliquer des comptes avec insertion de lettres

[momo]

Bonjour à tous

Je e permets de demander votre aide sur la possibilité de créer un macro qui puisse dupliquer certains numéros pré-choisi en y insérant une lettre

Je joins un fichier afin de mieux m'expliquer

Merci d'avance à tous

 

[momo]

re
tout a fait possible il faut seulement déterminer les critéres ou conditions
c'est pour cela qu il faut un fichier plus representatif du but a atteindre
exemple en colonne A la liste des comptes en colonne B le resultat attendu

Bonjour Laetitia
Merci pour ton retour. Je joins le fichier tel que demandé

 

[laetitia90]

re

exemple avec ton fichier
je suis passe par find pour la colonne 4... si pas assez rapide passerai par un autre "tablo"

 

[momo]

re

exemple avec ton fichier
je suis passe par find pour la colonne 4... si pas assez rapide passerai par un autre "tablo"

Amazing!!!! Franchement c'est impec ca marche !!!
Mais effectivement avec le nombre de ligne à gérer ça rame un peu
Je remplace le find par tablo simplement?

Ps: Le bouton de commande, est il possible de le déplacer?

 

[Lone-wolf]

Bonjour momo, laetitia , le Forum

Une simple sugestion. Dans une colonne (K par exemple) tu inscrit tous les numeros, et dans la colonne D, tu crée des listes déroulantes; ça éviterais ainsi de réecrire les numéros de compte.

 

[momo]

Bonjour momo, laetitia , le Forum

Une simple sugestion. Dans une colonne (K par exemple) tu inscrit tous les numeros, et dans la colonne D, tu crée des listes déroulantes; ça éviterais ainsi de réecrire les numéros de compte.

M. Wolf
En créant la liste déroulante, est ce qu'on peut afficher plusieurs comptes en même temps?

 

[laetitia90]

re
change ta macro par celle la
devrait être plus rapide
a mon avis c'est la colonne D qui contient beaucoup de données ???
colonne A suremement < 30000 lignes vu que je manipule application transpose pour la restitution

instruction FIND c'est une fonction equivalent formule excel =rechercheV

quand je parle de tablo ou tableau
en simple je remplis une plage de cellule que je stocke dans une variable tableau
Les éléments du tableau sont indexés séquentiellement
t = Range("a7:a" & Cells(Rows.Count, 1).End(3).Row)
dans ce cas mon tableau ou tablo se nomme t
le tableau est "charge" en memoire
avantage on bosse pas directement sur la feuille bien plus rapide
faire une recherche sur google si tu veus t'intéresser au manip de tableau

Sub es()
Dim t(), t1(), x As Long, i As Long, k As Long, z As Byte, car, nb As Byte, w As Byte, r, m As Object
  Application.ScreenUpdating = 0
  car = [b1]: nb = [c1]
  Set m = CreateObject("Scripting.Dictionary")
  t = Range("d2:d" & Cells(Rows.Count, 4).End(3).Row)
  For i = 1 To UBound(t): m(t(i, 1)) = t(i, 1): Next i
  t = Range("a7:a" & Cells(Rows.Count, 1).End(3).Row)
  For i = 1 To UBound(t)
  If m.Exists(t(i, 1)) Then w = 2 Else w = 1
  For z = 1 To w
  x = x + 1
  ReDim Preserve t1(1 To 1, 1 To x)
  For k = 1 To 1
  t1(k, x) = t(i, k)
  If z = 2 Then t1(k, x) = Left(t(i, k), nb) & car & Mid(t(i, k), nb + 1)
  Next k: Next z: Next i
[a7].Resize(x, 1) = Application.Transpose(t1)
End Sub

ps pour le bouton tu passe en mode creation est tu le met ou tu veus avec la souris

 

[momo]

re
change ta macro par celle la
devrait être plus rapide
a mon avis c'est la colonne D qui contient beaucoup de données ???
colonne A suremement < 30000 lignes vu que je manipule application transpose pour la restitution

instruction FIND c'est une fonction equivalent formule excel =rechercheV

quand je parle de tablo ou tableau
en simple je remplis une plage de cellule que je stocke dans une variable tableau
Les éléments du tableau sont indexés séquentiellement
t = Range("a7:a" & Cells(Rows.Count, 1).End(3).Row)
dans ce cas mon tableau ou tablo se nomme t
le tableau est "charge" en memoire
avantage on bosse pas directement sur la feuille bien plus rapide
faire une recherche sur google si tu veus t'intéresser au manip de tableau

Sub es()
Dim t(), t1(), x As Long, i As Long, k As Long, z As Byte, car, nb As Byte, w As Byte, r, m As Object
  Application.ScreenUpdating = 0
  car = [b1]: nb = [c1]
  Set m = CreateObject("Scripting.Dictionary")
  t = Range("d2:d" & Cells(Rows.Count, 4).End(3).Row)
  For i = 1 To UBound(t): m(t(i, 1)) = t(i, 1): Next i
  t = Range("a7:a" & Cells(Rows.Count, 1).End(3).Row)
  For i = 1 To UBound(t)
  If m.Exists(t(i, 1)) Then w = 2 Else w = 1
  For z = 1 To w
  x = x + 1
  ReDim Preserve t1(1 To 1, 1 To x)
  For k = 1 To 1
  t1(k, x) = t(i, k)
  If z = 2 Then t1(k, x) = Left(t(i, k), nb) & car & Mid(t(i, k), nb + 1)
  Next k: Next z: Next i
[a7].Resize(x, 1) = Application.Transpose(t1)
End Sub

ps pour le bouton tu passe en mode creation est tu le met ou tu veus

Un Maximum de Merci et de reconnaissance pour cette aide...

 

[Lone-wolf]

Re momo

Je ne c'est pas ci c'est possible, chaque client a son propre numéro de compte. Si celui-ci aurait plusieurs comptes, alors oui; en faisant des listes en cascades.

 

[momo]

Bonjour Leti

Comme demandé, je te met le fichier exemple.

Merciiii

 

[laetitia90]

bonjour tous
tu as pas mis la liste initial colonne a & b.... donc par déduction

Sub es()
Dim t(), t1(), x As Long, i As Long,  z As Byte, car, nb As Byte, w As Byte, m As Object
  Application.ScreenUpdating = 0
  car = [b1]: nb = [c1]
  Set m = CreateObject("Scripting.Dictionary")
  t = Range("d2:d" & Cells(Rows.Count, 4).End(3).Row)
  For i = 1 To UBound(t): m(t(i, 1)) = t(i, 1): Next i
  t = Range("a7:b" & Cells(Rows.Count, 1).End(3).Row)
  For i = 1 To UBound(t)
  If m.Exists(t(i, 1)) Then w = 2 Else w = 1
  For z = 1 To w
  x = x + 1
  ReDim Preserve t1(1 To 2, 1 To x)
  t1(1, x) = t(i, 1): t1(2, x) = t(i, 2)
   If z = 2 Then t1(1, x) = Left(t(i, 1), nb) & car & Mid(t(i, 1), nb + 1): t1(2, x) = t(i, 2)
Next z: Next i
[a7].Resize(x, 2) = Application.Transpose(t1)
End Sub

 

[momo]

bonjour tous
tu as pas mis la liste initial colonne a & b.... donc par déduction

Sub es()
Dim t(), t1(), x As Long, i As Long,  z As Byte, car, nb As Byte, w As Byte, m As Object
  Application.ScreenUpdating = 0
  car = [b1]: nb = [c1]
  Set m = CreateObject("Scripting.Dictionary")
  t = Range("d2:d" & Cells(Rows.Count, 4).End(3).Row)
  For i = 1 To UBound(t): m(t(i, 1)) = t(i, 1): Next i
  t = Range("a7:b" & Cells(Rows.Count, 1).End(3).Row)
  For i = 1 To UBound(t)
  If m.Exists(t(i, 1)) Then w = 2 Else w = 1
  For z = 1 To w
  x = x + 1
  ReDim Preserve t1(1 To 2, 1 To x)
  t1(1, x) = t(i, 1): t1(2, x) = t(i, 2)
   If z = 2 Then t1(1, x) = Left(t(i, 1), nb) & car & Mid(t(i, 1), nb + 1): t1(2, x) = t(i, 2)
Next z: Next i
[a7].Resize(x, 2) = Application.Transpose(t1)
End Sub

Bonjour Leti

Très bonne déduction .... C'est exactement ce que je voulais


Merci Beaucoup Leti;;;;;;;