XL 2010 Update Excel VBA

[psycosmos]

Bonjour les experts,

Je ne sais pas si quelqu’un peut m'aider pour un truc,
Je veux faire deux type de mise à jour du tableau ci-dessous, j'ai fait la moitié de travaillé pour le reste, merci de consulter l'image qui explique le besoin,
Ci-dessous le code pour la 1ére commande, mais il récupéré que le 1ére Key manquant, je dois cliquer plusieurs fois sur la macro pour récupérer tous les KEY manquants

Partie 1 :

Sub update_Key()

Dim i&, a&, NbLg&
Dim wsh As Worksheet
Set wsh = Sheets("Source")
With wsh
NbLg = .Range("A" & Rows.Count).End(xlUp).Row

Application.DisplayAlerts = False
For i = 2 To NbLg
For a = 2 To NbLg
If wsh.Cells(i, 1) = .Cells(a, 6) Then
GoTo 1
End If

Next a
wsh.Cells(NbLg + 1, 1) = wsh.Cells(i, 1)

1 Next i
End With
End Sub

La 2éme partie :

Je veux vérifier s’il existe un KEY sur la 2éme tableau avec un ID diffèrent si le cas je colle le KEY & le nouveau ID sur le tableau 1 ,

Merci pour votre support

 

[soan]

Bonjour psycosmos,

bonne année 2021, et bienvenue sur le site XLD !

ton fichier en retour ; fais Ctrl e ➯ travail effectué !

si tu ne vois pas la macro, c'est normal : tu dois d'abord faire
Alt F11 pour aller sur la fenêtre "Microsoft Visual Basic" ;
tu pourras alors voir le code VBA de Module1.

quand tu auras fini de lire le code VBA, n'oublie pas de faire
Alt F11 pour retourner sur Excel.

---

nota bene : tu trouveras le fichier Excel .png dans ton post #1, mais j'ai un
trou de mémoire : je ne me rappelle plus à laquelle de tes 2 images .png
je l'ai intégré. bon, je crois que tu as à peu près 1 chance sur 2 de le
trouver, soit environ 50% de chances ; si tu ne le trouves pas, alors c'est
que vraiment t'as la poisse : ne joue surtout pas au loto, ni au tiercé !

soan

 

[soan]

@psycosmos

bon allez, j'te rassure, t'as pas tant d'poisse que ça : comme y'avait pas trop de
données à recopier, j'ai quand même pris la peine de le faire ; mais normalement,
c'est pas mon job de le faire : c'était à toi de fournir un fichier et pas des images !

fais Ctrl e ➯ travail effectué :

avant exécution de la macro, y'avait rien en A5:B6, pas même les bordures !
(c'était le bled, quoi ; rien de rien, pas même un troquet, comme dirait Coluche)

Sub CpyData()
  Dim nlm&, dlg&: nlm = Rows.Count
  dlg = Cells(nlm, 6).End(3).Row: If dlg = 1 Then Exit Sub
  Dim key1 As Range, key2 As Range, lg2&, lg1&
  lg2 = Cells(nlm, 1).End(3).Row: Application.ScreenUpdating = 0
  For lg1 = 2 To dlg
    Set key1 = Cells(lg1, 6)
    If key1 <> "" Then
      Set key2 = Range("A2:A" & lg2).Find(key1, , -4163, 1, 1)
      If lg2 = 1 Or key2 Is Nothing Then
        lg2 = lg2 + 1
        With Cells(lg2, 1)
          .Value = key1: .Offset(, 1) = key1.Offset(, 1)
          With .Resize(, 2)
            .HorizontalAlignment = 1: .IndentLevel = 1
            .Borders.LineStyle = 1
          End With
        End With
      End If
    End If
  Next lg1
End Sub

soan

 

[soan]

@psycosmos

oh ben regarde comme le vent a tourné : la chance est maint'nant
d'ton côté : j'ai même retrouvé le fichier de la seconde partie !

fais Ctrl e ➯ travail effectué :

avant exécution de la macro, c'était l'même bled qu'avant exécution de la 1ère macro !
oui, c'est ça, dans l'même trou perdu : en A5:B6 ; rien de rien, même pas des bordures
d'autoroute ! et encore moins une Harley-Davidson ! c'est pas demain la veille que
tu pourras faire le trajet de la mythique Route 66 ! (USA, Chicago - Santa Monica)

tu auras bien remarqué, j'espère, que non seulement il y a « A-E33 / 001-A2 » en plus de
« A-E33 / 001-A1 », mais aussi, il y a « F-E15 / 005-A2 » en plus de « F-E15 / 005-A1 ».
(t'avais oublié de compléter le p'tit copain avec sa p'tite copine ! )

Sub CpyData()
  Dim nlm&, dl1&: nlm = Rows.Count
  dl1 = Cells(nlm, 6).End(3).Row: If dl1 = 1 Then Exit Sub
  Dim key1 As Range, id1$, dl2&, lg2&, lg1&, b1 As Byte, b2 As Byte
  dl2 = Cells(nlm, 1).End(3).Row: Application.ScreenUpdating = 0
  For lg1 = 2 To dl1
    Set key1 = Cells(lg1, 6)
    If key1 <> "" Then
      id1 = key1.Offset(, 1)
      If id1 <> "" Then
        b1 = 0: b2 = 0
        For lg2 = 2 To dl2
          If Cells(lg2, 1) = key1 Then
            b1 = 1: If Cells(lg2, 2) = id1 Then b2 = 1
          End If
        Next lg2
        If b1 = 1 And b2 = 0 Then
          dl2 = dl2 + 1
          With Cells(dl2, 1)
            .Value = key1: .Offset(, 1) = id1
            With .Resize(, 2)
              .HorizontalAlignment = 1: .IndentLevel = 1
              .Borders.LineStyle = 1
            End With
          End With
        End If
      End If
    End If
  Next lg1
End Sub

soan

 

[soan]

@psycosmos

je te laisse lire mes 3 posts précédents, à partir du post #2.

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

---

comme j'ai veillé très tard et qu'il est près de 5 h 20 du matin,
je vais arrêter pour aller me reposer longtemps.

alors t'étonnes pas si j'vais répondre très tardivement à ta
future éventuelle réponse. (ça risque de pas être avant 15 h, cet
après-midi, peut-être plus tard encore si j'vais aller faire des courses
à mon supermarché)

soan

 

[psycosmos]

Bonjour Soan , en vietnamien c'est un compositeur et en japonais c'est le Monsieur avec respect ,

merci infiniment pour ce travail professionnel ,tu bien compris le besoin ,

Les programmes doivent être faits pour être lus par des gens, et occasionnellement pour être exécutés par des machines c'est le cas pour ton code

Merci pour votre support & hELP

(TOPPPPPPPPPPPP FORUM)

 

[soan]

@psycosmos

merci pour ton retour ! j'suis ravi qu'tu aies apprécié
le code VBA de mes 2 fichiers !

nhạc nhẹ nhàng : MusiK EY ; MusiK AGI ; MusiK SZ

soạn

 

[psycosmos]

Bonjour Soan san

je retourne a toi encore une fois pour cette Topic , je suis sur le point de clôturer le fichier Global que je travail sur lui ,

je voulais juste savoir ajouter un commentaire sur la colonne (C) :

KEY2	ID	Impact			KEy1	ID
A-E33	001-A1				A-E33	001-A1
B-E30	002-R3				B-E30	002-R3
F-E15	005-A1				C-E20	001-A1
F-E15	005-A2	Impact Mineur			F-E15	005-A2
A-E33	001-A2	Impact Mineur			A-E33	001-A2
F-E15	005-B1	Impact Majeur			F-E15	005-B1

j'ai ajouté le code en Gras pour comparer les deux chaine de caractère avant de mettre à jour le Nouveau ID (S'il impact majeur ou mineur) en se basant sur l'ancien valeur de Key2

Sub CpyData()

Dim nlm&, dl1&: nlm = Rows.Count
dl1 = Cells(nlm, 6).End(3).Row: If dl1 = 1 Then Exit Sub
Dim key1 As Range, id1$, dl2&, lg2&, lg1&, b1 As Byte, b2 As Byte
dl2 = Cells(nlm, 1).End(3).Row: Application.ScreenUpdating = 0
For lg1 = 2 To dl1
Set key1 = Cells(lg1, 6)
If key1 <> "" Then
id1 = key1.Offset(, 1)
If id1 <> "" Then
b1 = 0: b2 = 0
For lg2 = 2 To dl2
If Cells(lg2, 1) = key1 Then
b1 = 1: If Cells(lg2, 2) = id1 Then b2 = 1
End If
Next lg2
If b1 = 1 And b2 = 0 Then
dl2 = dl2 + 1
With Cells(dl2, 1)
.Value = key1
.Offset(, 1) = id1
If Left(Cells(dl2, 1), 4) = Left(key1.Offset(, 1), 4) Then
Cells(dl2, 3) = "Impact Majeur"
Else
Cells(dl2, 3) = "Impact Mineur"
End With
End If
End If
End If
Next lg1

End Sub

est ce qu'il une possibilité ou pas , merci pour votre retour ,

Cordialement ,

 

[soan]

Bonjour psycosmos,

désolé de ne pas t'avoir répondu hier, ni ce matin ! (c'est par manque de temps, et pas un oubli)

ouvre le nouveau fichier ci-joint, et fais Ctrl e ➯ travail effectué :​

voici le nouveau code VBA :

Option Explicit

Sub CpyData()
  Dim nlm&, dl1&: nlm = Rows.Count
  dl1 = Cells(nlm, 6).End(3).Row: If dl1 = 1 Then Exit Sub
  Dim key1 As Range, id1$, id2$
  Dim chn$, dl2&, lg2&, lg1&, b1 As Byte, b2 As Byte
  dl2 = Cells(nlm, 1).End(3).Row: Application.ScreenUpdating = 0
  For lg1 = 2 To dl1
    Set key1 = Cells(lg1, 6)
    If key1 <> "" Then
      id1 = key1.Offset(, 1)
      If id1 <> "" Then
        b1 = 0: b2 = 0
        For lg2 = 2 To dl2
          If Cells(lg2, 1) = key1 Then
            b1 = 1: id2 = Cells(lg2, 2): If id2 = id1 Then b2 = 1
          End If
        Next lg2
        If b1 = 1 And b2 = 0 Then
          dl2 = dl2 + 1
          With Cells(dl2, 1)
            .Value = key1: .Offset(, 1) = id1
            If Left$(id2, 4) = Left$(id1, 4) Then
              chn = "Impact Majeur"
              If Mid$(id2, 5, 1) = Mid$(id1, 5, 1) Then Mid$(chn, 9, 2) = "in"
              .Offset(, 2) = chn
            End If
            With .Resize(, 3)
              .HorizontalAlignment = 1: .IndentLevel = 1: .Borders.LineStyle = 1
            End With
          End With
        End If
      End If
    End If
  Next lg1
End Sub

comme je ne peux pas mettre en gras des parties d'un code VBA qui est entre des balises de code, je dois te laisser trouver quelles sont les nombreuses différences (ce serait assez long de toutes les énumérer, mais j'espère que t'en oublieras aucune) ; bonne chance !

attention : la 1ère différence concerne les lignes Dim : j'ai déclaré 2 autres variables id2$ et chn$ ; la dernière différence est le With .Resize(, 3) au lieu de With .Resize(, 2) ; bien sûr, si tu auras besoin de plus d'infos, ou de quelques explications, tu peux me demander. ​

soan

 

[psycosmos]

Yoooo SAN Arigato

je tenais a vous exprimer mes remerciements pour la qualité du travail que vous avez effectué pour moi
vous avez bien répondu à mes besoins ,

merci infinimentttttttttttttttttttt enfin je clôture mon Project ….

 

[soan]

Bonjour psycosmos,

merci pour ton retour !

soan