Discussion :

[Fiorri]

Bonjour a Tous

je travail sur un fichier en format CSV qui contient des coordonnées X et Y, dans ce fichier j'ai une colonne intitulé POLYGONE,

problématique : La colonne contiens une chaîne de plusieurs caractères voici un exemple:

Polygon,((-5.50674593076109886,5.85401714779436588 ) : (-5.50767925567924976,6.00642110221087933) : (-5.41351703926920891,6.00702200084924698): (-5.41348200291395187,5.9988880343735218) : (-5.38981905207037926,5.99892809987068176) : (-5.38661976344883442,5.99412409588694572)....

Mon objectif est de réduire le nombre des chiffres après le (POINT) a 5 chiffre pour toute la chaîne ,c'est a dire je veux que ça soit :

Polygon,((-5.50674,5.85401 ) : (-5.50767,6.006421) : (-5.41351,6.00702 ) : (-5.41348,5.99888 ) : (-5.38981,5.99892 ) : (-5.38661,5.99412)....

NB: certaine lignes peuvent Contenir jusqu’à 100 doublant (X,Y).

Merci d'avance

[ARTURO83]

Bonjour,

Essayez ceci avec une fonction personnalisée, si le texte est en A2, saisissez la formule suivante en B2 (à tirer vers le bas):

Code :

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

=modif(A2)

Le code de la fonction utilisée

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
Function Modif(ch As Range) As String
    Dim NewCh As String
    Dim NbPt As Long, PVg As Long, Pf As Long, i As Long
    NewCh = ch
    NbPt = Len(NewCh) - Len(Replace(NewCh, ".", ""))
    Pos = 1
    For i = 1 To NbPt / 2
        Pt = InStr(Pos, NewCh, ".", 1) 'Position du point
        PVg = InStr(Pos + 8, NewCh, ",", 1) 'Position de la virgule
        PartieAConserver = Mid(NewCh, Pt, 6)
        PartieASupprimer = Mid(NewCh, Len(PartieAConserver) + Pt, PVg - Len(PartieAConserver) - Pt)
        NewCh = Replace(NewCh, PartieASupprimer, "")
        Pt = InStr(Pt + 1, NewCh, ".", 1) 'Position du point
        Pf = InStr(Pt + 1, NewCh, ")", 1) 'Position de la parenthèse fermante
        PartieAConserver = Mid(NewCh, Pt, 6)
        PartieASupprimer = Mid(NewCh, Len(PartieAConserver) + Pt, Pf - Len(PartieAConserver) - Pt)
        NewCh = Replace(NewCh, PartieASupprimer, "")
        Pf = InStr(Pt + 1, NewCh, ")", 1) 'Position de la parenthèse fermante
        Pos = Pf + 1
    Next i
    Modif = NewCh
End Function

Le fichier en exemple
Pièce jointe 516405

Cdlt

[Invité]

Bonjour,

A tester :

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
 
Public MatricePolygone
 
Sub TestPolygone1()
 
    Polygone1 Range("A1")
 
End Sub
 
Sub Polygone1(ByVal ChaineATraiter As String)
 
Dim IndexMatrice As Integer
Dim ChaineTraitee As Variant
Dim Coordonnees As Variant
 
        ChaineTraitee = Split(ChaineATraiter, ") : (")
 
        For IndexMatrice = LBound(ChaineTraitee) To UBound(ChaineTraitee)
            If IndexMatrice = 0 Then ChaineTraitee(IndexMatrice) = Mid(ChaineTraitee(IndexMatrice), Len("Polygon, (("))
            If IndexMatrice = UBound(ChaineTraitee) Then ChaineTraitee(IndexMatrice) = Mid(ChaineTraitee(IndexMatrice), 1, Len(ChaineTraitee(IndexMatrice)) - 2)
 
            Coordonnees = Split(ChaineTraitee(IndexMatrice), ",")
            Coordonnees(0) = Mid(Coordonnees(0), 1, 8)
            Coordonnees(1) = Mid(Coordonnees(1), 1, 7)
 
            ChaineTraitee(IndexMatrice) = "(" & Join(Coordonnees, ",") & ")" ' Mid(ChaineTraitee(IndexMatrice), Len("Polygon, (("))
 
            Debug.Print ChaineTraitee(IndexMatrice)
        Next IndexMatrice
 
End Sub

Il ne reste plus qu'un Join à réaliser avec la matrice ChaineTraitee pour recomposer votre polygone.

[Fiorri]

Bonjour,

Essayez ceci avec une fonction personnalisée, si le texte est en A2, saisissez la formule suivante en B2 (à tirer vers le bas):

Code :

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

=modif(A2)

Le code de la fonction utilisée

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
Function Modif(ch As Range) As String
    Dim NewCh As String
    Dim NbPt As Long, PVg As Long, Pf As Long, i As Long
    NewCh = ch
    NbPt = Len(NewCh) - Len(Replace(NewCh, ".", ""))
    Pos = 1
    For i = 1 To NbPt / 2
        Pt = InStr(Pos, NewCh, ".", 1) 'Position du point
        PVg = InStr(Pos + 8, NewCh, ",", 1) 'Position de la virgule
        PartieAConserver = Mid(NewCh, Pt, 6)
        PartieASupprimer = Mid(NewCh, Len(PartieAConserver) + Pt, PVg - Len(PartieAConserver) - Pt)
        NewCh = Replace(NewCh, PartieASupprimer, "")
        Pt = InStr(Pt + 1, NewCh, ".", 1) 'Position du point
        Pf = InStr(Pt + 1, NewCh, ")", 1) 'Position de la parenthèse fermante
        PartieAConserver = Mid(NewCh, Pt, 6)
        PartieASupprimer = Mid(NewCh, Len(PartieAConserver) + Pt, Pf - Len(PartieAConserver) - Pt)
        NewCh = Replace(NewCh, PartieASupprimer, "")
        Pf = InStr(Pt + 1, NewCh, ")", 1) 'Position de la parenthèse fermante
        Pos = Pf + 1
    Next i
    Modif = NewCh
End Function

Le fichier en exemple
Pièce jointe 516405

Cdlt

Bonjour ARTURO83

Merci beaucoup pour ton aide ça a fonctionné a merveille,

vraiment bravo toi et tous les Pro qui sont ici, sincèrement j'aimerai bien qu'un jours je puisse développer comme vous!

[unparia]

Bonjour
Voici une autre manière de traiter

Une fonction :

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Function reduire(c As String) As String
  Dim k As Long, e
  e = Split(Replace(Replace(c, "(", ",/,"), ")", ",//,"), ",")
  For k = 0 To UBound(e)
    If Val(e(k)) <> 0 Then
      e(k) = Fix(Val(e(k))) & Mid(e(k), InStr(e(k), "."), 6)
    End If
  Next
  reduire = Replace(Replace(Join(e, ","), ",/,", "("), ",//,", ")")
End Function

Appelable ainsi (exemple) :

Code :

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

1
2
3
Dim ch As String
  ch = "Polygon,((-5.50674593076109886,5.85401714779436588 ) : (-5.50767925567924976,6.00642110221087933) : (-5.41351703926920891,6.00702200084924698): (-5.41348200291395187,5.9988880343735218) : (-5.38981905207037926,5.99892809987068176) : (-5.38661976344883442,5.99412409588694572)...."
  MsgBox "voilà ce qu'est devenue ma chaine " & vbCrLf & reduire(ch)

[unparia]

Re

Bien qu'aucune précision n'ait été donnée à ce sujet, il nous faut envisager la possibilité de l'existence d'une chaîne de décimales de longueur inférieure à 5.

Voilà comment modifier la fonction pour y faire face en cas de besoin (modification minime dont il ne serait pas justifié de se priver):

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Function reduire(c As String) As String
  Dim k As Long, p As Integer, e
  e = Split(Replace(Replace(c, "(", ",/,"), ")", ",//,"), ",")
  For k = 0 To UBound(e)
    p = InStr(e(k), ".")
    If p > 0 Then
      If Val(e(k)) <> 0 And Len(Mid(e(k), p)) > 6 Then
        e(k) = Fix(Val(e(k))) & Mid(e(k), p, 6)
      End If
    End If
  Next
  reduire = Replace(Replace(Join(e, ","), ",/,", "("), ",//,", ")")
End Function