XL pour MAC addition de valeur en gras

[Velpri]

Bonjour la communauté,

J'ai transformé un document PDF en Excel, de ce document j'ai besoin de compter uniquement les valeur en gras, et idéalement j'aimerai supprimer toutes les valeurs qui ne sont pas en gras.
J'ai mis en pièce jointe un bout du mon fichier, et vous verrez en ouvrant le fichier, que la difficulté c'est que les valeurs sont dans des cellules fusionnées...

Mes explications ne sont pas des plus explicites, j’espère qu'en ouvrant le fichier vous comprendrez mieux 😉

 

[sylvanu]

Bonjour Velpri,
Attention, votre PJ semble ne pas être anonyme ! ( nom, adresse, compte bancaires ... )
Si c'est le cas veuillez la détruire immédiatement.
Vous l'anonymisez et la relivrer. Quelques lignes suffisent.

Ensuite sur le fond, ce n'est guère simple car il faut détecter une partie de chaine en gras.

 

[job75]

Bonjour Velpri, sylvanu,

Oui il faut anonymiser votre fichier.

En attendant vous pouvez toujours utiliser cette macro :

Sub Effacer_non_gras()
Dim t#, c As Range, x$, i%, n&
t = Timer
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
    If c <> "" Then
        x = c
        For i = Len(x) To 1 Step -1
            If Not c.Characters(i, 1).Font.Bold Then n = n + 1: x = Left(x, i - 1) & Mid(x, i + 1)
        Next i
        If IsNumeric(x) Then c = CDbl(x) Else c = x 'convertit en nombre
    End If
Next c
ActiveSheet.UsedRange.Font.Bold = True
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.00 \sec") & vbLf & vbLf & IIf(n, Format(n, "#,##0") & " caractères ont été effacés", "Aucun caractère n'a  été effacé"), , "Durée d'exécution"
End Sub

Les cellules fusionnées ne posent aucun problème.

A+

 

[Velpri]

Merci à vous deux,
je pensais avoir anonymiser mon fichier 😱

En tout cas la macro fonctionne parfaitement, mais du coup quand je veux utiliser la fonction "somme" cette dernière ne reconnais pas les valeurs dans les cellules 🙄

 

[sylvanu]

Bonjour Velpri, Job,
Peut être ainsi, en détectant le CHR(10) et en remettant les chaines sous format nombres.
Et plus rapide, 0.4s sur mon PC sur le fichier d'origine.

Sub Nettoie()
    Dim t, DL%, L%, C%, Pos%, Valeur
    t = Timer
    Application.ScreenUpdating = False
    DL = Range("J65500").End(xlUp).Row
    For C = 1 To 10
        For L = 10 To DL
            Chaine = Cells(L, C) & Chr(10)
            If Len(Chaine) > 1 Then
                Pos = Application.Search(Chr(10), Chaine)
                Valeur = Left(Chaine, Pos)
                If Valeur Like "*,*" Then Valeur = Val(Replace(Valeur, ",", "."))
                Cells(L, C) = Valeur
            End If
        Next L
    Next C
    MsgBox Format(Timer - t, "0.00 \sec")
End Sub

 

[job75]

J'avais compris qu'il fallait supprimer tous les caractères non gras.

Si on se limite aux nombres c'est bien sûr plus rapide.

Le fichier du post #4 n'a pas grand sens puisqu'il n'y a plus de caractères non gras.

J'ai donc anonymisé votre fichier d'origine et modifié la macro :

Sub Effacer_nombres_non_gras()
Dim t#, c As Range, s
t = Timer
Application.ScreenUpdating = False
For Each c In Range("B6:J" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    If c <> "" Then
        s = Split(c, vbLf)
        If IsNumeric(s(0)) Then c = CDbl(s(0)) Else c = s(0)
    End If
Next c
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.00 \sec"), , "Durée d'exécution"
End Sub

A+

 

[job75]

Sur la macro du post #3 j'ai complété la ligne :

If IsNumeric(x) Then c = CDbl(x) Else c = x 'convertit en nombre

 

[Velpri]

Super boulot, comme d'habitude

merci à vous