1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
phase1
Sub ExtraireNomsFichier()
Dim ws As Worksheet
Dim cell As Range
Dim nomFichier As String
Dim positionDernierAntiSlash As Integer
Dim positionDernierPoint As Integer
Set ws = ThisWorkbook.Sheets("Tag_fichiers_dossiers") ' Remplacez "Feuil1" par le nom de votre feuille
For Each cell In ws.Range("B:B") ' Parcourt chaque cellule de la colonne B
If cell.value <> "" Then ' Vérifie si la cellule n'est pas vide
nomFichier = cell.value ' Récupère le contenu de la cellule
' Trouve la position du dernier anti-slash pour gérer le chemin
positionDernierAntiSlash = InStrRev(nomFichier, "\")
' Trouve la position du dernier point pour gérer l'extension
positionDernierPoint = InStrRev(nomFichier, "")
If positionDernierAntiSlash > 0 And positionDernierPoint > 0 Then ' Vérifie si les positions sont valides
' Extrait uniquement le nom du fichier entre le dernier anti-slash et le dernier point
cell.Offset(0, -1).value = Mid(nomFichier, positionDernierAntiSlash + 1, positionDernierPoint - positionDernierAntiSlash - 0)
End If
End If
Next cell
End Sub
phase 2
Sub Copy_de_A_vers_G()
'Déclaration des variables
Dim ws As Worksheet
Dim value As String
Dim cell As Range
'Définition de la feuille de calcul à utiliser
Set ws = ThisWorkbook.Sheets("Tag_fichiers_dossiers") ' Remplacez "Sheet1" par le nom de votre feuille
'Boucle à travers les cellules de la plage A2:A450 de la feuille de calcul
For Each cell In ws.Range("A2:A450")
'Vérifie si le texte de la cellule contient '-' ou '.'
If InStrRev(cell.value, "-GA.") > 0 Then
'Si la cellule contient '-', extraire la partie avant '-' dans 'value'
value = Left(cell.value, InStrRev(cell.value, "-GA.") - 1)
ElseIf InStrRev(cell.value, ".") > 0 Then
'Si la cellule contient '.', extraire la partie avant '.' dans 'value'
value = Left(cell.value, InStrRev(cell.value, ".") - 1)
Else
'Sinon, définir 'value' comme la valeur de la cellule
value = cell.value
End If
'Écrire la valeur traitée dans la colonne G de la même ligne que la cellule actuelle
cell.Offset(0, 6).value = value
Next cell
End Sub
Phase 3
Sub RemplirColonneF()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
' Spécifier la feuille de calcul
Set ws = ThisWorkbook.Sheets("Tag_fichiers_dossiers") ' Remplacez "NomFeuille" par le nom de votre feuille
' Trouver la dernière ligne avec des données dans la colonne A
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Parcourir chaque ligne avec des données dans la colonne A
For i = 1 To lastRow
If InStr(2, UCase(ws.Cells(i, 7).value), "N1") > 0 Then
ws.Cells(i, 6).value = "Gammes N1\"
ElseIf InStr(1, UCase(ws.Cells(i, 7).value), "N2") > 0 Then
ws.Cells(i, 6).value = "Gammes N2\"
ElseIf InStr(1, UCase(ws.Cells(i, 7).value), "N3") > 0 Then
ws.Cells(i, 6).value = "Gammes N3\"
Else
' Mettre une valeur par défaut si aucun des mots n'est trouvé
ws.Cells(2, 6).value = ""
End If
Next i
End Sub
phase 4
Sub repertoire_destination()
' Déclarer les variables
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
' Spécifier la feuille de calcul
Set ws = ThisWorkbook.Worksheets("Tag_fichiers_dossiers")
' Trouver la dernière ligne avec des données dans la colonne E
lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
' Boucler à travers les lignes avec des données dans la colonne E
For i = 2 To lastRow
' Copier la valeur en colonne C dans la colonne E et concaténer les valeurs
ws.Cells(i, "C").value = ws.Cells(i, "E").value & ws.Cells(i, "C").value & _
ws.Cells(i, "F").value & ws.Cells(i, "G").value & _
ws.Cells(i, "H").value
' Cette ligne fusionne les valeurs de colonnes E, F, G, H et C dans la colonne F de la même ligne
Next i
End Sub |
faire de 4 codes Vba en un seule
Répondre avec citation
Partager