Comment extraire les sous-chaines avant le tiret "-" dans la colonne A
ainsi que la valeur correspondante dans la colonne B pour avoir dans
Feuil2 le r=E9sultat suivant :
Laboratoire............... Abr=E9viation
Biologie Bio
Chimie Chm
Electronique Eln
Electricit=E9 Elt
Sub Essai() Set mondico = CreateObject("Scripting.Dictionary") '------------- lecture anciens
Set f = Sheets("feuil2") If [F2] <> "" Then For Each c In f.Range("f2", f.[f65000].End(xlUp)) mondico.Add c.Value, c.Offset(0, 1) Next c End If '------------- ajout des nouveaux Set f = Sheets("feuil1") For Each c In f.Range("B2", f.[B65000].End(xlUp)) If Not mondico.Exists(c.Value) Then mondico.Add c.Value, Left(c.Offset(0, -1), InStr(c.Offset(0, -1), "-") - 1) Next c [F2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys) [g2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items) End Sub
JB
On 3 déc, 19:54, Apitos wrote:
Bonsoir JB et tous le forum,
Si la macro est exécutée pour la première fois (colonne F et G de Feuil2 sont vides) je reçois cette erreur :
Sub Essai()
Set mondico = CreateObject("Scripting.Dictionary")
'------------- lecture anciens
Set f = Sheets("feuil2")
If [F2] <> "" Then
For Each c In f.Range("f2", f.[f65000].End(xlUp))
mondico.Add c.Value, c.Offset(0, 1)
Next c
End If
'------------- ajout des nouveaux
Set f = Sheets("feuil1")
For Each c In f.Range("B2", f.[B65000].End(xlUp))
If Not mondico.Exists(c.Value) Then mondico.Add c.Value,
Left(c.Offset(0, -1), InStr(c.Offset(0, -1), "-") - 1)
Next c
[F2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
[g2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
End Sub
JB
On 3 déc, 19:54, Apitos <api...@gmail.com> wrote:
Bonsoir JB et tous le forum,
Si la macro est exécutée pour la première fois (colonne F et G de
Feuil2 sont vides) je reçois cette erreur :
Sub Essai() Set mondico = CreateObject("Scripting.Dictionary") '------------- lecture anciens
Set f = Sheets("feuil2") If [F2] <> "" Then For Each c In f.Range("f2", f.[f65000].End(xlUp)) mondico.Add c.Value, c.Offset(0, 1) Next c End If '------------- ajout des nouveaux Set f = Sheets("feuil1") For Each c In f.Range("B2", f.[B65000].End(xlUp)) If Not mondico.Exists(c.Value) Then mondico.Add c.Value, Left(c.Offset(0, -1), InStr(c.Offset(0, -1), "-") - 1) Next c [F2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys) [g2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items) End Sub
JB
On 3 déc, 19:54, Apitos wrote:
Bonsoir JB et tous le forum,
Si la macro est exécutée pour la première fois (colonne F et G de Feuil2 sont vides) je reçois cette erreur :
