luke3300
XLDnaute Impliqué
Bonjour à tous,
Je profite d'un jour de congé pour améliorer un fichier que le forum m'avait aidé à créer.
Dans le code ci-dessous, j'aimerais enlever le fait que les données de la 3ème colonne n'aient plus de lettre devant leur nombre parce qu'actuellement, lorsque les données sont des nombres tels que 801, 999, S704, etc ... le code ne laissent que le derniers chiffre. J'aimerais qu'il laisse l'intitulé en entier.
Qui peut me dire ce que je dois enlever/modifier dans ce code?
Merci d'avance et bon appétit 😀
Je profite d'un jour de congé pour améliorer un fichier que le forum m'avait aidé à créer.
Dans le code ci-dessous, j'aimerais enlever le fait que les données de la 3ème colonne n'aient plus de lettre devant leur nombre parce qu'actuellement, lorsque les données sont des nombres tels que 801, 999, S704, etc ... le code ne laissent que le derniers chiffre. J'aimerais qu'il laisse l'intitulé en entier.
Qui peut me dire ce que je dois enlever/modifier dans ce code?
Code:
Sub Titulariat()
'
' Configure le DL - Racourci ctrl + k
'
Application.ScreenUpdating = False
Range("E:K,C:C").Delete
Range("F25").Select
Dim c As Range, f As Worksheet, d As Object
Set d = CreateObject("scripting.dictionary")
d.comparemode = 1
Set f = Worksheets("DL") 'Feuil3
f.Activate
With f
'.Rows ("1:" & .Columns(1).Find("Ancien NoTourn", LookAt:=xlPart).Row - 1).Delete Shift:=xlUp à enlever car pas de lignes à supprimer au-dessus!
For Each c In .Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp).Address)
If c.Value Like "Reg" & "*" Then
c = Mid(c, 5) * 1
End If
c.Offset(, 2) = Mid(c.Offset(, 2), 2) * 1
Next
f.UsedRange.Sort key1:=Columns(3), order1:=1, key2:=Columns(1), order2:=1, Header:=xlYes
For a = 2 To .UsedRange.Rows.Count
If Not d.exists(.Cells(a, 3).Value) Then
d.Item(.Cells(a, 3).Value) = ""
Else
If Not d.Item(.Cells(a, 3).Value) Like "*" & .Cells(a, 1) & "*" Then
d.Item(.Cells(a, 3).Value) = d.Item(.Cells(a, 3).Value) & "/" & .Cells(a, 1)
End If
End If
Next
With .Cells(1, 5).Resize(, d.Count)
.Value = d.keys
.Font.Bold = True
End With
.Cells(2, 5).Resize(, d.Count) = d.items
For a = 5 To .Cells(1, Columns.Count).End(xlToLeft).Column
b = Split(.Cells(2, a), "/")
For e = 3 To UBound(b) + 3
.Cells(e, a) = b(e - 3)
Next e
Range(.Cells(2, a), .Cells(3, a)).Delete Shift:=xlUp
Next a
.Cells(1, 5).CurrentRegion.Offset(1, 0).Copy
End With
Sheets("Nouveau G").Activate
Range("f10").PasteSpecial Paste:=xlValues
Set d = Nothing
Set f = Nothing
Sheets("DL").Select
Columns("E:GV").Select
Selection.ColumnWidth = 3.86
Range("E1:GV1000").Select
Selection.NumberFormat = "General"
Range("D1").Select
End SubMerci d'avance et bon appétit 😀
Dernière édition:
