Discussion :

[Kiveudesprunos]

Bonsoir à tous,

Je galère depuis quelques temps pour extraire des chaines de caractères d'une cellule excel et recopie de valeurs liées à ces chaines de caractères par le biais de formules..
Force est de constaté qu'il va falloir puiser dans le VBA pour m'en sortir. Quelqu'un aurait il une idée sur la façon de procéder ? merci d'avance

[joe.levrai]

Bonjour,

ceci fonctionne sur le fichier que tu nous montres

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
Sub Comptabilisation()
 
Dim Ligne As Long
Dim Colonne As Long
Dim Position As Long
 
With ThisWorkbook.Worksheets("Feuil1")
    ' dernière ligne
    Ligne = .Cells(Rows.Count, 1).End(xlUp).Row
    ' dernière colonne
    Colonne = .Cells(1, Columns.Count).End(xlToLeft).Column
 
    ' parcours les lignes
    For Ligne = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        ' parcours les colonnes
        For Colonne = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            ' cherche le DKxxx dans la ligne
            If .Cells(Ligne, 1) Like "*" & .Cells(1, Colonne) & "*" Then
                'position de la fin du DLKxxx dans la ligne
                Position = InStr(1, .Cells(Ligne, 1), .Cells(1, Colonne)) + 3
                ' écriture du résultat, en identifiant la virgule dans le chiffre
                .Cells(Ligne, Colonne) = CDbl(Mid(.Cells(Ligne, 1), Position + 3, InStr(Position, .Cells(Ligne, 1), ",") - Position))
            End If
        Next Colonne
    Next Ligne
End With
 
End Sub

[gnain]

Bonjour,
Bonne méthode joe.levrai
mais tu as oublier d'additionner si il y en à 2 de pareils comme demandé.

voici une autre méthode

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
Sub recherche_DLK()
    Range("B2:AL20").ClearContents
    Range("B2:AL20").NumberFormat = "0.00"
    For k = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Dim WrdArray() As String
        WrdArray() = Split(Cells(k, 1), "DLK")
 
        For i = LBound(WrdArray) To UBound(WrdArray)
            If i > 0 Then
                For j = 2 To 38
                    If Left(Cells(1, j).Value, 5) = "DLK" & Left(WrdArray(i), 2) Then
                        Cells(k, j).Value = Cells(k, j).Value + Replace(Mid(WrdArray(i), 4, 4), ",", ".")
                    End If
                Next
            End If
        Next i
    Next k
End Sub

[Kiveudesprunos]

Qu’elle rapidité... la macro de joe fonctionne sans additionner , c’est déja un premier pas et la tienne Gnain me demande de déterminer la variable ! Erreur de compilation sur la boucle For k = 2 ,ce qui pour moi est littéralement du Mandarin puisque je débute à peine en Vba je m’y suis mis hier soir...
En tout cas c’est sympa d’avoir répondu à ma sollicitation.

[gnain]

Bonjour,

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
Sub recherche_DLK()
    Dim k As Long
    Dim i As Integer
    Dim j As Integer
    Range("B2:AL20").ClearContents
    Range("B2:AL20").NumberFormat = "0.00"
    For k = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Dim WrdArray() As String
        WrdArray() = Split(Cells(k, 1), "DLK")
 
        For i = LBound(WrdArray) To UBound(WrdArray)
            If i > 0 Then
                For j = 2 To 38
                    If Left(Cells(1, j).Value, 5) = "DLK" & Left(WrdArray(i), 2) Then
                        Cells(k, j).Value = Cells(k, j).Value + Replace(Mid(WrdArray(i), 4, 4), ",", ".")
                    End If
                Next
            End If
        Next i
    Next k
End Sub

[joe.levrai]

Bonjour,

merci gnain pour la remarque, j'avais pas vu les doublons

ceci semble corriger ma bêtise

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
Sub Comptabilisation()
 
Dim Ligne As Long
Dim Colonne As Long
Dim Position As Long
 
With ThisWorkbook.Worksheets("Feuil1")
    For Ligne = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        For Colonne = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
            Position = 1
            If .Cells(Ligne, 1) Like "*" & .Cells(1, Colonne) & "*" Then
                Do
                    Position = InStr(Position, .Cells(Ligne, 1), .Cells(1, Colonne)) + 3
                    If Position = 3 Then Exit Do
                    .Cells(Ligne, Colonne) = .Cells(Ligne, Colonne) + CDbl(Mid(.Cells(Ligne, 1), Position + 3, InStr(Position, .Cells(Ligne, 1), ",") - Position))
                Loop
            End If
        Next Colonne
    Next Ligne
End With
 
End Sub

[Kiveudesprunos]

Erreur incompatibilité type 13 sur la ligne

Code :

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

Cells(k,  j).value = Cells(k,  j).value + Replace(Mid(WrdArray(i),  4,  4),  ",",  ".")

Pour mon info personnel qu’elle est la fonction de cette ligne ?
Sinon la macro de Joe marche nickel et va me faire gagner un temps précieux...un grand merci à tous deux pour ma compréhension grandissante de ce langage précieux..👏

[joe.levrai]

Cette ligne additionne la valeur de ta cellule de résultat de chaque DKxxx

Code :

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

Cells(k, j).value = Cells(k, j).value + Replace(Mid(WrdArray(i), 4, 4), ",", ".")

Cells(k,j) est ta cellule qui contient l'addition de ton DKxxx

chaque WrdArray(i) contient une portion de ta cellule, la portion commençant par un (DLK) "xxx = x,xx"

Mid permet de récupérer une portion d'une chaine de caractère : ici, gnain récupère les 4 derniers caractères, en partant de la position 4 de "xxx = x,xx"

Replace permet de changer une portion de chaine par une autre
==> ici, gnain remplace les virgules par des points, pour effectuer ensuite les additions (VBA étant anglais, le séparateur de décimal est un point)

je te conseille de passer ta souris sur les fonctions, et d'appuyer sur F1 pour avoir des informations à leur sujet

pour ton erreur d'incompatibilité, j'ai l'impression qu'il faut récupérer à partir du 5ème caractère au lieu du 4 ?
si on part de la position 4, on récupère " = x,x " ?
et en partant de la position 5, on récupère " x,xx " ?

en attendant que gnain revienne sur le fil (il saura mieux que moi corriger si besoin )
essaye :

Code :

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

Replace(Mid(WrdArray(i), 5, 4), ",", ".")

[Kiveudesprunos]

Merci pour ton aide précieuse

[Docmarti]

Bonjour.

Une autre suggestion, celle-ci utilisant un double split:

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
Sub tt()
 
    Set f = ActiveSheet
    dernCol = f.Cells(1, Columns.Count).End(xlToLeft).Column
    dernLig = f.Cells(Rows.Count, "A").End(xlUp).Row
    Set Tableau = f.Range(f.Cells(1, "B"), f.Cells(dernLig, dernCol))
    Set titres = Tableau.Rows(1)
    Tableau.Offset(1).ClearContents
 
    For i = 2 To dernLig
        t = Split(f.Cells(i, "A"), "DLK")
        For n = 1 To UBound(t)
            ss = Split(t(n), "=")
            numero = ss(0): Valeur = Val(Replace(ss(1), ",", "."))
            Set col = titres.Find(what:="DLK" & numero)
            If col Is Nothing Then
                MsgBox "DLK" & numero, , "non trouvee"
            Else
                f.Cells(i, col.Column) = f.Cells(i, col.Column) + Valeur
            End If
        Next
    Next
 
End Sub

[patricktoulon]

bonjour
et bien dis donc il y a des claviers qui doivent être usés hein!....

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
    derlig = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2:Al" & derlig) = ""
    Range("B2:AL" & derlig).NumberFormat = "0.00"
    For i = 2 To derlig
        tablig = Split(Cells(i, 1), "DLK")
        For e = 1 To UBound(tablig)
            colonne = Val(Split(tablig(e), "=")(0)) + 1
            valeur = Val(Replace(Split(tablig(e), "=")(1), ",", "."))
            Cells(i, colonne) = Cells(i, colonne) + valeur
        Next
    Next
End Sub

edit: docmarti on a eu la même idée on s'est croisé
a une différence prêt j'utilise l'index de colonne récupéré dans le "DLK"

[Promethee25]

Bonjour,

Les expressions régulières sont une bonne solution à ton problème:

Sous VBA, créer la fonction personnalisée suivante:

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
'Cocher Outils => Références => Microsoft VBScript Regular Expressions 5.5
'Fonction matricielle permettant d'extraire une ou plusieurs infos d'un texte à l'aide d'un "pattern" (motif) basé sur les expressions régulières
'Cette fonction renverra la/les info(s) pour toutes les occurrences du pattern dans le texte: une ligne par occurrence; une colonne par info au sein de l'occurrence
'Renvoie #VALEUR si rien n'est trouvé.
Function SplitWithRegExp(str As String, pattern As String)
    Dim regExType As New VBScript_RegExp_55.RegExp
    regExType.pattern = pattern
    regExType.Global = True 'True matches all occurrences, False matches the first occurrence
    Dim matches As VBScript_RegExp_55.matchCollection
    Dim match As VBScript_RegExp_55.match
    Dim subMatch
    Dim tabMatch() 'As String
    Dim i As Long
    Dim j As Long
 
    i = 1
    j = 1
 
    Set matches = regExType.Execute(str)
 
    ReDim tabMatch(1 To matches.Count, 1 To VBA.Len(VBA.Replace(pattern, "\(", "")) - VBA.Len(VBA.Replace(VBA.Replace(pattern, "\(", ""), "(", "")))
 
    For Each match In matches
 
        For Each subMatch In match.SubMatches
           tabMatch(i, j) = subMatch
           j = j + 1
        Next subMatch
        j = 1
        i = i + 1
    Next match
 
    SplitWithRegExp = tabMatch
End Function

Utilisation de cette fonction dans une formule Excel en B2 (à étirer dans tout le tableau):

Code :

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

=SIERREUR(SOMME(CNUM(SplitWithRegExp($A2; "" & B$1 & "\=(\d+\,\d+)"))); "")

=> Formule matricielle à valider par Ctrl+Maj+Entrée.

L'avantage par rapport aux autres solutions est que la fonction VBA est 100% générique donc pas de maintenance du code lorsque ton tableau Excel évolue.

[patricktoulon]

bonjour promethé

heu..... il a vingt lignes et c'est un débutant commençons par le début non?
oh le pauvre !......

[Promethee25]

Je propose, il dispose...

Cette solution me semble idéale, pourquoi la taire?

[patricktoulon]

il dispose?
oh le pauvre faudrait d'abords qu'il en comprenne une ligne pour cela il lui manque quelques heures a mon avis
c'était le sens de ma remarque non pas celui de la véracité de ta démo

[Promethee25]

J'ai bien compris mais je lui propose de passer de l'obscurantisme à la Lumière... (humour je précise)
Je peux lui apporter quelques explications si ça l'intéresse bien sûr.

[patricktoulon]

J'ai bien compris mais je lui propose de passer de l'obscurantisme à la Lumière... (humour je précise)

ah!.. ben là pour le coups il va avoir besoins d'un ophtalmo et de cachés d'aspirine

[Promethee25]

Lol, j'avais pas pensé aux effets de bord...

[joe.levrai]

Et si on passait par un dictionnaire ?

On met ça dans un msocontrol d'un menu perso, avec une option pour les bordures

Promis, garanti sans XML

[/PatrickBashing]

[patricktoulon]

qui ,quoi, comment, parce que
voila que maintenant on parle de bordure?