angelita009
XLDnaute Nouveau
J'ai une liste de 2500 Lignes, j'aimerai bien l’abrévié un mot au bien ensemble des mots si le nombre de caractère dans une cellule est supérieur à 250 caractères.
J'ai réalisé une macro qui fonctionner très bien mais il remplace seulement un mot.
Sub Abréviation()
Sheets(1).Select
Range("A1").Select
NbLig = Range(Selection, Selection.End(xlDown)).Count
For J = 1 To NbLig
If Len(Cells(J, 1).Value) > 250 Then
Cells(J, 1).Select
For Each c In Selection
a = Split(c, " ")
For i = LBound(a) To UBound(a)
Set TEMP = Sheets(2).Range("a2:a11").Find(What:=a(i), LookAt:=xlWhole)
If Not TEMP Is Nothing Then
a(i) = TEMP.Offset(, 1).Value
J = J - 1
Exit For
End If
Next i
c.Value = Join(a, " ")
Next
End If
Next J
End Sub
J'ai réalisé un autre mais trop long
Sub Macro1()
Dim val As Variant
Dim val1 As Variant
Sheets(1).Select
Cells(1, 1).Select
nb = Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Count
Sheets(2).Select
Cells(1, 1).Select
nb1 = Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Count
For j = 2 To nb1
For i = 2 To nb
Sheets(1).Select
If Len(Cells(i, 1).Value) > 250 Then
Sheets(2).Select
val = Cells(j, 1).Value
val1 = Cells(j, 2).Value
If InStr(Replace(Cells(i, 1).Value, "¦", " "), val) <> 0 Then
Cells(i, 1) = Replace(Replace(Cells(i, 1).Value, "¦", " "), val, val1)
End If
End If
Next i
Next j
End Sub
😕 😕 😕 😕 😕 😕 😕 😕 😕 😕
J'ai réalisé une macro qui fonctionner très bien mais il remplace seulement un mot.
Sub Abréviation()
Sheets(1).Select
Range("A1").Select
NbLig = Range(Selection, Selection.End(xlDown)).Count
For J = 1 To NbLig
If Len(Cells(J, 1).Value) > 250 Then
Cells(J, 1).Select
For Each c In Selection
a = Split(c, " ")
For i = LBound(a) To UBound(a)
Set TEMP = Sheets(2).Range("a2:a11").Find(What:=a(i), LookAt:=xlWhole)
If Not TEMP Is Nothing Then
a(i) = TEMP.Offset(, 1).Value
J = J - 1
Exit For
End If
Next i
c.Value = Join(a, " ")
Next
End If
Next J
End Sub
J'ai réalisé un autre mais trop long
Sub Macro1()
Dim val As Variant
Dim val1 As Variant
Sheets(1).Select
Cells(1, 1).Select
nb = Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Count
Sheets(2).Select
Cells(1, 1).Select
nb1 = Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Count
For j = 2 To nb1
For i = 2 To nb
Sheets(1).Select
If Len(Cells(i, 1).Value) > 250 Then
Sheets(2).Select
val = Cells(j, 1).Value
val1 = Cells(j, 2).Value
If InStr(Replace(Cells(i, 1).Value, "¦", " "), val) <> 0 Then
Cells(i, 1) = Replace(Replace(Cells(i, 1).Value, "¦", " "), val, val1)
End If
End If
Next i
Next j
End Sub
😕 😕 😕 😕 😕 😕 😕 😕 😕 😕
