[VBA] - Récupérer les données d'un document word importé dans Excel

Bonjour,

Pour l'élaboration d'une base de données, j'ai besoin de récupérer certaines informations et de les organiser en lignes/colonnes.

Voici la procédure que j'imagine être la meilleure pour obtenir les informations que je recherche :

En [colonne B] :

• Supprimer les chiffre
• Supprimer les valeurs qui ne contiennent pas de "."

(Cette partie je sais faire)

- A chaque fois que la première lettre est suivie d'un point, alors rechercher, en [colonne A] la première données en gras située dans les lignes au dessus.

Ex : A. arboreus : [Col A] ; (Ligne 4) : premier mot en gras : "Acanthus"

(Je ne sais pas faire)

- Ecrire le résultat à la suite en [colonne D] (ok)

En [colonne B]

- A chaque fois que la première lettre est suivie d'un point, alors

Rechercher les données renseignées entre le 4ème et le 5ème "—".

(J'ai beaucoup de mal avec la gestion des chaînes de caractères quand ça devient tendu comme ça)

- Ecrire le résultat en [colonne E]

Ci-joint, un fichier qui illustre mieux ce que je cherche à faire.

J'ai quelques idées à tester d'ici ce soir, notamment sur la recherche des mots en gras. Je reviendrai avec les résultats, si j'en ai !

Je vous remercie de votre attention

Bonne journée !

Bonjour Drosophile,

Toujours en recherche d'un coup de main?

Bonjour,

Justement je comptais écrire à la suite de ce post dans la journée.

J'ai pratiquement terminé, quelques détails à régler, mais tout s'exécute très bien !

J'ai un premier code qui nettoie un peu le document en supprimant ce qui me gène :

Dim wsa As Worksheets
Dim lrA&

'Set wsa = Worksheets("Table")

'Set dc = Worksheets("Données Collector")

lrA = Worksheets("Table").Cells(Rows.Count, 1).End(xlUp).Row

        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="1", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="2", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="3", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="4", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="5", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="6", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="7", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="8", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="9", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Worksheets("Table").Range(Cells(1, 2), Cells(lrA, 2)).Replace What:="'", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

For c = 2 To lrA
    If UCase(Cells(c, 2).Value) Like "*.*" Then
        If UCase(Cells(c, 2).Value) Like "*subsp.*" Or UCase(Cells(c, 2).Value) Like "*var.*" Then
            Else
            Cells(c, 2) = Mid(Cells(c, 2), 4)
        End If
    Else
        Cells(c, 2).Clear
    End If
Next c

Puis je récupère les données qui m'intéressent :

lrow = tb.Cells(Rows.Count, 1).End(xlUp).Row

lrA = Worksheets("Table").Cells(Rows.Count, 1).End(xlUp).Row

With tb
    .Range(Cells(1, 1), Cells(lrA, 2)).Font.Bold = False
        For Each cel In Range("A1:A" & Range("A65536").End(xlUp).Row)
            If cel.Characters(1, 1).Font.Italic = True Then
                cel.Offset(0, 2).Value = cel
            End If
        Next cel
End With

For Each cel1 In Range("C1:C" & lrA)
    If cel1 = "" Then
    Else
        cel1.Offset(0, 1).Value = Split(Trim(cel1.Value), " ")(0) 'Mid(tb.Cells(4, 2), InStrRev(tb.Cells(4, 2), " ") + 1)
    End If
Next cel1

Columns("C:C").EntireColumn.Delete

Set tb = Worksheets("Table")

'boucle sur toutes les cellules éditées de la plage A1:A_fin (À adapter)
lrow = tb.Cells(Rows.Count, 1).End(xlUp).Row

lrA = Worksheets("Table").Cells(Rows.Count, 1).End(xlUp).Row

tb.Cells(1, 3) = "Espèce"
tb.Cells(1, 4) = "Habitat"
tb.Cells(1, 5) = "Biogéographie"
tb.Cells(1, 5) = "Répartition France"

With tb
For Each cel2 In Range("A1:D" & lrA)
    If cel2 = "" Then
    Else
        If cel2.Characters(1, 1).Font.Italic = True Then
        Else
            If Left(cel2.Value, 1) = "1" Or Left(cel2.Value, 1) = "2" Or Left(cel2.Value, 1) = "3" _
            Or Left(cel2.Value, 1) = "4" Or Left(cel2.Value, 1) = "5" Or Left(cel2.Value, 1) = "6" _
            Or Left(cel2.Value, 1) = "7" Or Left(cel2.Value, 1) = "8" Or Left(cel2.Value, 1) = "9" _
            Or Left(cel2.Value, 1) = "a" Or Left(cel2.Value, 1) = "g" Or Left(cel2.Value, 1) = "b" _
            Or Left(cel2.Value, 1) = "c" Then
            Else
                If Not UCase(cel2.Value) Like "*—*" Then
                Else
                                If InStr(1, cel2, "—") > 3 Then
                                    cel2.Offset(0, 4).Value = Split(Trim(cel2.Value), "—")(4)
                                    cel2.Offset(0, 5).Value = Split(Trim(cel2.Value), "—")(5)
                                    cel2.Offset(0, 6).Value = Split(Trim(cel2.Value), "—")(3)

                                Else
                                End If
                End If
            End If
        End If
    End If
Next cel2
End With

Columns("A:A").EntireColumn.Delete

Je vais bientôt pouvoir clore le sujet

Voilà, a priori tout fonctionne.

Le code est bien, même s'il y a un peu de bidouille par ci par là..

Il ne devrait pas beaucoup me servir ; uniquement pour transformer des livres en bases de données.

Merci

Bonne soirée !