Discussion :

[mkweb]

Bonjour,

J'ai un fichier excel contenant des cellules dans lesquelles ont trouve des mots en caractères barrés.
Je dois mettre le mot sauf devant les parties barrées. Le code ci dessous fonctionne pour certaines cellules, mais si la cellule contient des termes non barrés cela ne fonctionne pas. Il faut donc que je teste la présence du striketrough sur chaque caractères de chaque cellule.

Merci pour vos réponses

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Dim i As Integer
Dim sContenu As String
For i = 1 To 5000
        Range("A" + CStr(i)).Select
        sContenu = ActiveCell.FormulaR1C1
        If ActiveCell.Font.Strikethrough = True Then
            ActiveCell.FormulaR1C1 = "sauf " + sContenu
            ActiveCell.Font.Strikethrough = False
            ActiveCell.Font.Color = vbRed
        End If

[AnneCa]

Je ne comprend pas trop où est le problème. J'ai testé ton code (j'ai ajouté next i pour finir la boucle) et cela fonctionne: les cellules barrées ont été remplacées par "sauf " + la valeur précédente de la cellule.
Reformule ta question, STP

[mkweb]

Oui pour le next il est passé à la trappe lors du copier coller

Dans le cas d'une cellule contenant par exemple :
Peugeot 206 -ABS-

Seul ABS est en style barré et là cela ne fonctionne pas, il faut que le résultat devienne :
Peugeot 206 sauf ABS

Merci pour ton commentaire

En fait la question qui résumerait le mieux mon problème serait par exemple:

Comment puis savoir si le dixième caractère d'une cellule est en strikethrough (barré)?

Merci pour votre aide

[helas]

Bonjour,
il faut tester chaque caractère, si un seul est barré, on applique la modif

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim i As Integer
For i = 1 To 5000 
  With Range("A" + CStr(i))
    For k = 1 To Len(Range("A" + CStr(i)))
     If .Characters(k, 1).Font.Strikethrough Then
            .FormulaR1C1 = "sauf " + Range("A" + CStr(i))
            .Font.Strikethrough = False
            .Font.Color = vbRed
      End If
    Next k
   End With
Next i

[mercatog]

Une proposition

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 i As Integer, k As Integer
 
For i = 1 To Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    k = 1
    With Range("A" & i)
        If Len(.Value) >0 Then
            Do
                If Not .Characters(k, 1).Font.Strikethrough Then
                    k = k + 1
                Else
                    Exit Do
                End If
            Loop Until k = Len(.Value)
            If k < Len(.Value) Then
                .Value = Left(.Value, k - 1) & "sauf " & Mid(.Value, k)
                .Font.Strikethrough = False
            End If
        End If
    End With
Next i

[ESVBA]

Code :

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

.Font.Strikethrough

vaut :

"True" si toute la cellule est barrée
"False" si toute la cellule n'est pas barrée
"Null" si une partie de la cellule est barrée


Donc un simple test "IF ISNULL() Then" suffit.

ESVBA

[mercatog]

Oui mais il faut récupérer la position du premier caractère barré!!

[ESVBA]

A force de survoler et de croire que l'on sait...

Merci de m'avoir rectifier.

ESVBA

[mkweb]

Merci,
Ca va beaucoup m'aider pour mes 5200 lignes. Plus les 50'000 lignes à venir.
Je teste et je confirmerai la résolution.

[mercatog]

déclare

Code :

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

Dim i As Long

Edit: une proposition complète

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
Dim i As Long, k As Integer
 
For i = 1 To Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    k = 1
    With Range("A" & i)
        If Trim(.Value) <> "" Then
            If .Font.Strikethrough Then
                .Value = "Sauf " & .Value
            ElseIf IsNull(.Font.Strikethrough) Then
                Do
                    If Not .Characters(k, 1).Font.Strikethrough Then
                        k = k + 1
                    Else
                        Exit Do
                    End If
                Loop Until k = Len(.Value) + 1
 
                If k <= Len(.Value) Then
                    .Value = Left(.Value, k - 1) & "Sauf " & Mid(.Value, k)
                End If
            End If
            .Font.Strikethrough = False
        End If
    End With
Next i

[mkweb]

Ca marche très bien, merci ça va me faciliter la vie et me permettre d'importer correctement les données (catalogues automobiles).