Microsoft 365 VBA - Recherche valeur dans un tableau et ajout texte

[ted1057]

Bonjour,

Je cherche à modifier un fichier de débit que j'ai récupéré. J'ai une liste de longueur de coupe sur laquelle est associé un repère. J'aimerais pouvoir ajouter au débit cette désignation de repérage.
Exemple :

nombre	longueur du coupe (mm)	REP	Qté	Reste
5	1448	3	1x	188	4x1448

Je cherche à obtenir : 4x1448 - Rep : 3

Cela pour toutes les lignes du tableau

Merci de vos retours

Cordialement,

 

[job75]

Bonsoir ted1057,

Le repère est bien tranquille en colonne F, pourquoi vouloir l'introduire en colonnes I ou J ?

Car alors il faut des formules dans ces colonnes, ou du VBA.

A+

 

[job75]

Par exemple en I2 il faudra entrer la formule ="4x1448 - Rep : "&F2

et faire la même chose pour chaque cellule des colonnes I et J., c'est fastidieux..

 

[ted1057]

Bonsoir ted1057,

Le repère est bien tranquille en colonne F, pourquoi vouloir l'introduire en colonnes I ou J ?

Car alors il faut des formules dans ces colonnes, ou du VBA.

A+

Bonjour,

Merci de ta réponse,

Je suis d'accord avec toi le Repère est bien au chaud dans sa colonne. Pour mon exemple, il n'y a que quelques lignes mais je peux être amené à devoir effectuer un débit de plus de 100 lignes et ainsi retrouver la bonne longueur dans le débit peut être long et fastidieux pour un rangement par repère. De plus, j'aurais besoin de cette information pour la nouvelle machine que mon entreprise vient d'acquérir.

D'ou ma demande si il y avait une possibilité d'effectuer cette étape sous VBA.

Cordialement,

 

[job75]

Bonjour ted1057, le forum,

La macro affectée au bouton :

Sub MAJ()
Dim c As Range, v
Application.ScreenUpdating = False
For Each c In Range("F2", Range("F" & Rows.Count).End(xlUp)(2))
    If c <> "" Then
        If c(1, 4) <> "" Then
            v = Left(c(1, 4), InStr(c(1, 4) & " ", " ") - 1)
            c(1, 4) = v & " - Rep : " & c
        End If
        If c(1, 5) <> "" Then
            v = Left(c(1, 5), InStr(c(1, 5) & " ", " ") - 1)
            c(1, 5) = v & " - Rep : " & c
        End If
    End If
Next
Columns("I:J").AutoFit 'ajustement largeurs
End Sub

La macro peut être exécutée plusieurs fois de suite sans inconvénient.

A+

 

[ted1057]

Bonjour ted1057, le forum,

La macro affectée au bouton :

Sub MAJ()
Dim c As Range, v
Application.ScreenUpdating = False
For Each c In Range("F2", Range("F" & Rows.Count).End(xlUp)(2))
    If c <> "" Then
        If c(1, 4) <> "" Then
            v = Left(c(1, 4), InStr(c(1, 4) & " ", " ") - 1)
            c(1, 4) = v & " - Rep : " & c
        End If
        If c(1, 5) <> "" Then
            v = Left(c(1, 5), InStr(c(1, 5) & " ", " ") - 1)
            c(1, 5) = v & " - Rep : " & c
        End If
    End If
Next
Columns("I:J").AutoFit 'ajustement largeurs
End Sub

La macro peut être exécutée plusieurs fois de suite sans inconvénient.

A+

Bonjour,

Merci pour ta réponse, j'ai un soucis dans le fonctionnement de la macro.
Les numéros de repères ne sont pas affecté à la bonne longueur.
Dans le fichier, nous avons 1448mm qui est toujours affectée au Rep3 peut importe ou se trouve cette longueur dans le débit.
Ci joint, un fichier avec le résultat à obtenir sachant que le nombre de débit peut dépasser les 2 colonnes.


Cordialement,

 

[job75]

Alors cette version (2) qui utilise le Dictionary :

Sub MAJ()
Dim d As Object, c As Range, v, s
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For Each c In Range("E2", Range("E" & Rows.Count).End(xlUp)(2))
    If c <> "" And c(1, 2) <> "" Then d(CStr(c)) = c(1, 2)
Next c
For Each c In Range("I2", Range("I" & Rows.Count).End(xlUp)(2))
    If c <> "" Then
        v = Left(c, InStr(c & " ", " ") - 1)
        s = Split(v, "x")
        If UBound(s) > 0 Then c = v & " - Rep : " & d(s(1))
    End If
Next c
For Each c In Range("J2", Range("J" & Rows.Count).End(xlUp)(2))
    If c <> "" Then
        v = Left(c, InStr(c & " ", " ") - 1)
        s = Split(v, "x")
        If UBound(s) > 0 Then c = v & " - Rep : " & d(s(1))
    End If
Next c
Columns("I:J").AutoFit 'ajustement largeurs
End Sub

 

[ted1057]

Alors cette version (2) qui utilise le Dictionary :

Sub MAJ()
Dim d As Object, c As Range, v, s
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For Each c In Range("E2", Range("E" & Rows.Count).End(xlUp)(2))
    If c <> "" And c(1, 2) <> "" Then d(CStr(c)) = c(1, 2)
Next c
For Each c In Range("I2", Range("I" & Rows.Count).End(xlUp)(2))
    If c <> "" Then
        v = Left(c, InStr(c & " ", " ") - 1)
        s = Split(v, "x")
        If UBound(s) > 0 Then c = v & " - Rep : " & d(s(1))
    End If
Next c
For Each c In Range("J2", Range("J" & Rows.Count).End(xlUp)(2))
    If c <> "" Then
        v = Left(c, InStr(c & " ", " ") - 1)
        s = Split(v, "x")
        If UBound(s) > 0 Then c = v & " - Rep : " & d(s(1))
    End If
Next c
Columns("I:J").AutoFit 'ajustement largeurs
End Sub

OMG c'est super cela marche trop bien,
merci énormément

 

[job75]

sachant que le nombre de débit peut dépasser les 2 colonnes.

Alors utilisez plutôt cette version (3) :

Sub MAJ()
Dim d As Object, c As Range, v, s, col%, plage As Range
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For Each c In Range("E2", Range("E" & Rows.Count).End(xlUp)(2))
    If c <> "" And c(1, 2) <> "" Then d(CStr(c)) = c(1, 2)
Next c
For col = 9 To 256
    Set plage = Range(Cells(2, col), Cells(Rows.Count, col).End(xlUp)(2))
    If Application.CountA(plage) = 0 Then Exit For
    For Each c In plage
        If c <> "" Then
            v = Left(c, InStr(c & " ", " ") - 1)
            s = Split(v, "x")
            If UBound(s) > 0 Then c = v & " - Rep : " & d(s(1))
        End If
Next c, col
Columns("I:IV").AutoFit 'ajustement largeurs
End Sub

 

[ted1057]

Alors utilisez plutôt cette version (3) :

Sub MAJ()
Dim d As Object, c As Range, v, s, col%, plage As Range
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For Each c In Range("E2", Range("E" & Rows.Count).End(xlUp)(2))
    If c <> "" And c(1, 2) <> "" Then d(CStr(c)) = c(1, 2)
Next c
For col = 9 To 256
    Set plage = Range(Cells(2, col), Cells(Rows.Count, col).End(xlUp)(2))
    If Application.CountA(plage) = 0 Then Exit For
    For Each c In plage
        If c <> "" Then
            v = Left(c, InStr(c & " ", " ") - 1)
            s = Split(v, "x")
            If UBound(s) > 0 Then c = v & " - Rep : " & d(s(1))
        End If
Next c, col
Columns("I:IV").AutoFit 'ajustement largeurs
End Sub

Trop bien,
Grand merci à vous