Discussion :

[Leodams]

Bonjour,

J'ai fait un code avec ma petite expérience VBA et je bloque sur le point suivant:

J'aimerais supprimer le dernier caractère dans la colonne D des valeurs commençant par "ARPEGE\A" .

Avec le code ci-dessous cela fonctionne mais à chaque fois que je l’exécute il m’enlève de nouveau un caractère .

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
  Dim cell As Range
  Dim datarange
Set datarange = Sheets("liste transferts").Range("D:D")
 
    Columns("D:D").Select
 
    Selection.Replace What:="GL00X", Replacement:="ARPEGE\X", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="GL00", Replacement:="ARPEGE\A", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
For Each cell In datarange
 
  If Left$(cell.Value, 8) = "ARPEGE\A" Then
  cell = Left(cell.Value, Len(cell.Value) - 1)
  End If
 
  Next

Est -il possible de mettre le même nombrer de caractère pour toutes les valeurs de la colonne D soit 14 caractères ?
Cela évitera de spécifier de faire le changement seulement sur les valeurs commençant pas "ARPEGE\A".

Merci de votre aide

[clementmarcotte]

Bonjour,

Avec le code ci-dessous cela fonctionne mais à chaque fois que je l’exécute il m’enlève de nouveau un caractère .

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
For Each cell In datarange
 
  If Left$(cell.Value, 8) = "ARPEGE\A" Then
  cell = Left(cell.Value, Len(cell.Value) - 1)
  End If
 
  Next

Il fait exactement ce que tu lui dis de faire. Il faudrait que tu trouves ou ajoute le moyen de tester si ton texte a déjà été "esquinté" et de sauter par dessus la cellule en cause.

Est -il possible de mettre le même nombrer de caractère pour toutes les valeurs de la colonne D soit 14 caractères ?
Cela évitera de spécifier de faire le changement seulement sur les valeurs commençant pas "ARPEGE\A".

En théorie oui. Mais tu as aussi besoin d'un moyen pour "prolonger" une donnée qui n'aurait pas 14 caractères. (Je présume que tu pourrais ajouter des blancs.)

Toujours en théorie, tu devrais t'assurer que tes blancs ou autres caractères supplémentaires ne nuiraient pas ailleurs.

Pour les chaînes trop longues, l'idée de base serait dans ce genre-là:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A1").value = left(range("A1").value,13)

Mais là, encore, attention aux répercussions.

[Leodams]

bonjour,

Je n'arrive pas à obtenir le resultat voulu avec le code que vous m'avez indiqué.

Dans la colonnes D je dois avoir seulement 14 caractéres s'il y en a 15 il doit supprimer automatiquement le dernier chiffre.

Le code ci-dessous effectue bien cette tâche. Mais lorsque j'éxecute une deuxieme fois le code, il me supprime encore un chiffre de toutes les valeurs commençant par "ARPEGE\A".

[Philippe Tulliez]

Bonjour,
Ce que tu écris est très étonnant.
Le code proposé par Clément ne garde que les 13 caractères de gauche de la chaîne. Ce code peut donc tourner plusieurs fois il restera toujours un maximum de 13 caractères.

[Leodams]

ah du coup cela ne fonctionne pas car ma valeur est centré dans la cellule.

Je vais faire le teste de nouveau.

[Philippe Tulliez]

Bonjour,
Est-ce pour rire ou bien changes tu en cours de route tes demandes ?

J'aimerais supprimer le dernier caractère dans la colonne D des valeurs commençant par "ARPEGE\A" .

Il me semble à te lire que tu parles bien du dernier caractère (donc à droite) en tous les cas pour la langue française.

[Leodams]

non je te confirme que cela doit supprimer le caractére de droite.

Le probléme c'est que n'arrive pas modifier mon code de départ

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Moving()

Dim cell As Range
Dim datarange
Dim WsSrc As Worksheet
Dim Wsdest As Worksheet


Set datarange = Sheets("Moving").Range("D:D")
Set WsSrc = Sheets("Moving")
Set Wsdest = Sheets("déploiement")

With WsSrc
Range("D1:D3000").Replace What:="GL00X", Replacement:="ARPEGE\X", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
Range("D1:D3000").Replace What:="GL00", Replacement:="ARPEGE\A", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

End With

For Each cell In datarange

If Left$(cell.Value, 8) = "ARPEGE\A" Then
cell = Left(cell.Value, Len(cell.Value) - 1)
End If
Next

End Sub

Ou est le probléme merci pour votre aide

Bonjour,

Je souhaiterais aussi par la même occasion introduire une comparaison de date.

L'idée :

Si les dates de la colonne Q sont supérieurs que ceux de la colonnes AC sur la même ligne alors mettre une couleur rouge sur la date de la colonne AC

le probléme c'est que je ne sais pas comment introduire ça dans le code ci-dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Recherche_Moving()

Dim cell As Range
Dim WsSrc As Worksheet
Dim Wsdest As Worksheet
Set WsSrc = Sheets("Moving")
Set Wsdest = Sheets("déploiement")
nbcolonne2 = Wsdest.UsedRange.Columns.Count
nbligne2 = Wsdest.UsedRange.Rows.Count



For Each cell In Wsdest.Range("j1:j" & Wsdest.Range("j" & Rows.Count).End(xlUp).Row)


    Set j = WsSrc.Range("d:d").Find(cell, LookIn:=xlValues, LookAt:=xlWhole)
    
If Not j Is Nothing Then


With Wsdest

.Cells(cell.Row, 29) = WsSrc.Cells(j.Row, 13) 'renvoi la date du Moving
.Cells(cell.Row, 24) = WsSrc.Cells(j.Row, 14) 'renvoi la tour
.Cells(cell.Row, 25) = WsSrc.Cells(j.Row, 12) 'renvoi la localisation



End With

End If

Next cell

For i = 2 To nbligne2
If Wsdest.Cells(i, 2).Value < Wsdest.Cells(i, 3) Then
Wsdest.Cells(i, 1).Interior.Color = 3End If
Next


End Sub

Si vous avez des pistes je preneur.

Merci

[EngueEngue]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For i = 2 To nbligne2
If Wsdest.Cells(i, 17).Value > Wsdest.Cells(i, 29) Then
Wsdest.Cells(i, 29).Interior.Color = RGB(100,0,0)
Next

[Leodams]

Bonjour,

En creusant bien j'ai pu trouver une solution avec vos différentes pistes:


Pour mettre tous les cellules de la colonnes D au même nombre de caractères:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For Each cell In datarange
    If Left$(cell.Value, 8) = "ARPEGE\A" And Len(cell.Value) <> 14 Then
        cell = Left(cell.Value, Len(cell.Value) - 1)
    End If

Ce point est résolu.
Merci à tous