Sub Test2()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim TWorkon As Range, TDévia As Range
Dim Position As Integer, MemoPos As Integer
Set WsS = Worksheets("Workon")
Set WsC = Worksheets("Data-Deviations")
Sheets("Data-Deviations").Activate
Range("AI2:AI1000000").ClearContents
TDévia = WsC.Range("AG2:AH" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
TWorkon = WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
For Ld = 1 To UBound(TDévia)
mempos = 1000
For Lw = 1 To UBound(TWorkon)
Position = InStr(TDévia(Ld, 1), TWorkon(Lw, 1))
If Position > 0 Then
If TDévia.Offset(0, 2) <> "" And InStr(TDévia.Offset(0, 2), TWorkon.Offset(0, 1)) = 0 Then
' ligne And InStr(TDévia.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
If Position < MemoPos Then
MemoPos = Position
TDévia.Offset(0, 2) = TWorkon.Offset(0, 1) & Chr(10) & TDévia.Offset(0, 2)
Else
TDévia.Offset(0, 2) = TDévia.Offset(0, 2) & Chr(10) & TWorkon.Offset(0, 1)
End If
Else
TDévia.Offset(0, 2) = TWorkon.Offset(0, 1)
MemoPos = Position
End If
End If
Next TWorkon
Next TDévia
Set WsC = Nothing: Set WsS = Nothing
Application.ScreenUpdating = True
End Sub
ub Test2()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim TWorkon As Range, TDévia As Range
Dim Position As Integer, MemoPos As Integer
Set WsS = Worksheets("Workon")
Set WsC = Worksheets("Data-Deviations")
Sheets("Data-Deviations").Activate
Range("AI2:AI1000000").ClearContents
TDévia = WsC.Range("AG2:AH" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
TWorkon = WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
For Ld = 1 To UBound(TDévia)
mempos = 1000
For Lw = 1 To UBound(TWorkon)
Position = InStr(TDévia(Ld, 1), TWorkon(Lw, 1))
If Position > 0 Then
If TDévia(Ld, 2) <> "" And InStr(TDévia(Ld, 2), TWorkon(Lw, 1)) = 0 Then
' ligne And InStr(TDévia.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
If Position < MemoPos Then
MemoPos = Position
TDévia(Ld, 2) = TWorkon(Lw, 1) & Chr(10) & TDévia(Ld, 2)
Else
TDévia(Ld, 2) = TDévia(Ld, 2) & Chr(10) & TWorkon(Lw, 1)
End If
Else
TDévia(Ld, 2) = TWorkon(Lw, 1)
MemoPos = Position
End If
End If
Next TWorkon
Next TDévia
Set WsC = Nothing: Set WsS = Nothing
Application.ScreenUpdating = True
End Sub
Sub Test2()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet
Dim TWorkon As Range, TDévia As Range, TRésu As Range
Dim Position As Integer, MemoPos As Integer
Set WsS = Worksheets("Workon")
Set WsC = Worksheets("Data-Deviations")
Sheets("Data-Deviations").Activate
Range("AI2:AI1000000").ClearContents
TDévia = WsC.Range("AG2:AH" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
TWorkon = WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
For Ld = 1 To UBound(TDévia)
ReDim TRésu(1 To UBound(TDévia), 1 To 1)
mempos = 1000
For Lw = 1 To UBound(TWorkon)
Position = InStr(TDévia(Ld, 1), TWorkon(Lw, 1))
If Position > 0 Then
If TDévia(Ld, 2) <> "" And InStr(TDévia(Ld, 2), TWorkon(Lw, 1)) = 0 Then
' ligne And InStr(TDévia.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
If Position < MemoPos Then
MemoPos = Position
TDévia(Ld, 2) = TWorkon(Lw, 1) & Chr(10) & TDévia(Ld, 2)
Else
TDévia(Ld, 2) = TDévia(Ld, 2) & Chr(10) & TWorkon(Lw, 1)
End If
Else
TDévia(Ld, 2) = TWorkon(Lw, 1)
MemoPos = Position
End If
End If
Next TWorkon
Next TDévia
TRésu(Ld, 1) = RésultatCellClassé
Set WsC = Nothing: Set WsS = Nothing
CelluleDeDépart.Resize(UBound(TRésu)).Value = TRésu
Application.ScreenUpdating = True
End Sub
Sub Test()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet, TDévia(), Ld&, TWorkon(), Lw&, TRésu()
Set WsS = Worksheets("Workon")
Set WsC = Worksheets("Data-Deviations")
TDévia = WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
ReDim TRésu(1 To UBound(TDévia), 1 To 1)
TWorkon = WsS.Range("S2:T" & WsS.Range("S" & Rows.Count).End(xlUp).Row).Value
For Ld = 1 To UBound(TDévia)
For Lw = 1 To UBound(TWorkon)
If InStr(TDévia(Ld, 1), TWorkon(Lw, 1)) > 0 Then Ajouter TWorkon(Lw, 2)
Next Lw
TRésu(Ld, 1) = RésultatCellClassé: Next Ld
WsC.[AI].Resize(UBound(TRésu)).Value = TRésu
End Sub
If InStr(TDévia(Ld, 1), TWorkon(Lw, 1)) > 0 Then Ajouter TWorkon(Lw, 2)
Sub Test()
Application.ScreenUpdating = False
Dim WsS As Worksheet, WsC As Worksheet, TDévia(), Ld&, TWorkon(), Lw&, TRésu()
Set WsS = Worksheets("Workon")
Set WsC = Worksheets("Data-Deviations")
TDévia = WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row).Value
ReDim TRésu(1 To UBound(TDévia), 1 To 1)
TWorkon = WsS.Range("S2:T" & WsS.Range("S" & Rows.Count).End(xlUp).Row).Value
For Ld = 1 To UBound(TDévia)
For Lw = 1 To UBound(TWorkon)
If InStr(TDévia(Ld, 1), TWorkon(Lw, 1)) > 0 Then Ajouter TWorkon(Lw, 2)
Next Lw
TRésu(Ld, 1) = RésultatCellClassé: Next Ld
WsC.[AI].Resize(UBound(TRésu)).Value = TRésu
Application.ScreenUpdating = True
End Sub
Sub Ajouter(ByVal Z As String)
Le = Le + 1: Te(Le) = Z
End Sub
Oui, c'est ça.Que veux dire le ByVal on passe l'argument sous forme de valeur?