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

ted1057 · 15 Novembre 2023

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 · 15 Novembre 2023

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 · 15 Novembre 2023

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 · 16 Novembre 2023

job75 à dit:
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 · 16 Novembre 2023

Bonjour ted1057, le forum,

La macro affectée au bouton :

VB:

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 · 16 Novembre 2023

job75 à dit:

Bonjour ted1057, le forum,

La macro affectée au bouton :

VB:

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 · 16 Novembre 2023

Alors cette version (2) qui utilise le Dictionary :

VB:

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 · 16 Novembre 2023

job75 à dit:

Alors cette version (2) qui utilise le Dictionary :

VB:

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 · 16 Novembre 2023

ted1057 à dit:
sachant que le nombre de débit peut dépasser les 2 colonnes.

Alors utilisez plutôt cette version (3) :

VB:

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 · 16 Novembre 2023

job75 à dit:

Alors utilisez plutôt cette version (3) :

VB:

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

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

ted1057

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

ted1057

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

ted1057

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

ted1057

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

ted1057

XLDnaute Occasionnel

Discussions similaires