Discussion :

[FanTasTik]

Bonjour,

J'ai un tableau de donnée composée d'au moins 3 colonnes et de plusieurs milliers de lignes et un moteur de recherche par mot clé.

lorsque je recherche un mot clé, le moteur va chercher dans 3 colonnes spécifiques si il trouve le mot. Si il le trouve au moins une fois sur un ligne, il prend la ligne et la recopie sur une autre feuille de manière à obtenir le tableau des résultats.

J'aimerais bien mettre dans le tableau de résultat toutes les occurences du mot clé en bleu et en gras. Pour cela j'ai développé un module qui me fait ça sur un cellule et je l'applique à toutes les cellules des 3 colonnes du tableau de résultat.

Le problème c'est que c'est lent, si quelqu'un pense pouvoir optimiser mon algo ou alors la manière de concevoir la résolution du problème (par exemple traiter les colonnes dans leur ensemble et non pas faire cellule par cellule etc...) j'en serais ravi

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
 
Sub toto(i, j, keyword)
 
    Dim debut As Integer
    With Sheets("Feuil1")
    debut = InStr(1, .Cells(i, j).Value, keyword)
    While debut > 0
        With .Cells(i, j).Characters(Start:=InStr(debut, .Cells(i, j).Value, keyword), Length:=Len(keyword)).Font
                        .Color = -4165632
                        .Bold = True
        End With
        debut = InStr(debut + Len(keyword), .Cells(i, j).Value, keyword)
    Wend
    End With
End Sub

[Daniel.C]

Bonjour,

"Mot" représente le mot cherché. J'ai supposé qu'il n'était présent qu'une fois par cellule. La zone cherchée est les colonnes A:C.

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
Sub test1(Mot)
    Dim c As Range, ResAdr As String, Debut
    Application.ScreenUpdating = False
    Set c = [Feuil1!A:C].Find(Mot)
    If Not c Is Nothing Then
        ResAdr = c.Address
        Do
            Debut = InStr(1, c.Value, Mot)
            With c.Characters(InStr(Debut, c.Value, Mot), Len(Mot)).Font
                .Color = -4165632
                .Bold = True
            End With
            Set c = [Feuil1!A:C].FindNext(c)
        Loop While c.Address <> ResAdr
    End If
    Application.ScreenUpdating = True
End Sub

[FanTasTik]

Le problème c'est que le caractère peut être présent plusieurs fois par cellule et qu'il doit être colorié aussi même si c'est la la deuxième fois qu'il apparaît etc...

[Daniel.C]

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
Sub test1(Mot)
    Dim c As Range, ResAdr As String, Debut As Integer, Res As Integer
    Application.ScreenUpdating = False
    Set c = [Feuil1!A:C].Find(Mot)
    If Not c Is Nothing Then
        ResAdr = c.Address
        Do
            Res = 0
            Debut = InStr(1, c.Value, Mot)
            Do While Debut > 0 And Debut > Res
                With c.Characters(InStr(Debut, c.Value, Mot), Len(Mot)).Font
                    .Color = -4165632
                    .Bold = True
                End With
                c.Characters(InStr(Debut, c.Value, Mot), Len(Mot)).Text = "***"
                Res = Debut
                Debut = InStr(1, c.Value, Mot)
                c.Characters(InStr(Res, c.Value, "***"), Len(Mot)).Text = Mot
            Loop
            Set c = [Feuil1!A:C].FindNext(c)
        Loop While c.Address <> ResAdr
    End If
    Application.ScreenUpdating = True
End Sub

[ESVBA]

Il y aura un problème si l'on recherche un mot de moins de trois lettres. Il va rester une ou deux étoiles. Voici une proposition de correction :

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 test1(Mot)
    Dim c As Range, ResAdr As String, Debut As Integer, Res As Integer
    Application.ScreenUpdating = False
    Set c = [Feuil1!A:C].Find(Mot)
    If Not c Is Nothing Then
        ResAdr = c.Address
        Do
            Res = 0
            Debut = InStr(1, c.Value, Mot)
            Do While Debut > 0 And Debut > Res
                With c.Characters(InStr(Debut, c.Value, Mot), Len(Mot)).Font
                    .Color = -4165632
                    .Bold = True
                End With
                'c.Characters(InStr(Debut, c.Value, Mot), Len(Mot)).Text = "***"
                Res = Debut
                Debut = InStr(Res+1, c.Value, Mot)
                'c.Characters(InStr(Res, c.Value, "***"), Len(Mot)).Text = Mot
            Loop
            Set c = [Feuil1!A:C].FindNext(c)
        Loop While c.Address <> ResAdr
    End If
    Application.ScreenUpdating = True
End Sub

ESVBA

[sdispro]

Salut,

J'ai ce code, qui recherche dans les colonne a-b-c le mot "b".
Soit tu intègre le mot recherché dans ton code, soit tu définit une inputbox.
Délai de la macro: infiniment petit


' Macro2 Macro
'

'

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
Columns("A:C").Select
    With Application.ReplaceFormat.Font
        .FontStyle = "Gras"
        .Subscript = False
        .ThemeColor = 4
        .TintAndShade = 0
    End With
    With Application.ReplaceFormat.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Replace What:="b", Replacement:="b", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=True
    Range("D20").Select
End Sub