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

laetitia90 à dit:

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

Cliquez pour agrandir...

laetitia90 à dit:

re🙂

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

Cliquez pour agrandir...

Lone-wolf à dit:

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.

Cliquez pour agrandir...

laetitia90 à dit:

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

VB:

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

Cliquez pour agrandir...

laetitia90 à dit:

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

VB:

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

Cliquez pour agrandir...