Séparer le titre en mots et le rechercher dans un autre titre

0

J'essayais d'automatiser un fichier Excel comportant un titre dans les colonnes A et B. Je dois rechercher chaque mot de A dans B. Si un mot correspond, je dois le coller après la colonne B disponible (C, D, ...) au même rang.

J'utilisais le code ci-dessous pour lequel je vais séparer les mots manuellement dans une colonne séparée de la colonne A titre et les rechercher dans la colonne B.

Dim a() As String
Dim b() As String
Dim aRng As Range
Dim cel As Range
Dim i As Integer, t As Integer, clm As Integer

Set aRng = Range(Range("KW1"), Range("KW1").End(xlDown))

For Each cel In aRng
    a = Split(cel, " ")
    b = Split(cel.Offset(, 1), " ")
    clm = 2

    For i = LBound(a) To UBound(a)
        For t = LBound(b) To UBound(b)
            If UCase(a(i)) = UCase(b(t)) Then
                cel.Offset(, clm) = a(i)
                clm = clm + 1
            End If
        Next
    Next

Next

mais il répète des mots en double encore et encore s'il y en a. Y a-t-il un moyen d'éviter les mots en double? Sil te plait aide moi.

microsoft-excel microsoft-excel-2007 vba Linga
la source
Donc, il faut imprimer chaque mot qui correspond entre A et B? Je dirais utiliser des tableaux. Si vous souhaitez éviter les doublons, utilisez un dictionnaire - mais vous devrez l'effacer après chaque ligne.
Raystafarian

Réponses:

0

Ce n'est pas vraiment la méthode la plus propre, mais vous pouvez simplement vérifier chaque cellule remplie en les parcourant en boucle à partir d'un décalage de 2 jusqu'à atteindre une cellule vide. Notez que ce code n'est pas testé.

For i = LBound(a) To UBound(a)
    For t = LBound(b) To UBound(b)
        If UCase(a(i)) = UCase(b(t)) Then
            clm = 2
            Do While True
                If UCase(cel.Offset(, clm)) = UCase(a(i)) Then
                    Exit Do
                End If
                If cel.Offset(, clm) = "" Then
                    cel.Offset(, clm) = a(i)
                    Exit Do
                End If
                clm = clm + 1
            Loop
        End If
    Next
Next
Jason Clement
la source
Salut Jason, j'essayais d'utiliser pour la boucle au lieu de faire dans le code ci-dessus et je me suis perdu. Pourriez-vous s'il vous plaît m'aider?
Linga
Do While fonctionne car il boucle jusqu'à trouver une cellule vide. Pour utiliser une boucle For, vous devez rechercher la dernière cellule utilisée dans cette ligne et boucler de 2 à cette colonne + 1, ou vous devez simplement parcourir toutes les colonnes de cette ligne et quitter lorsque vous trouvez une correspondance. ou atteindre une cellule vide. Pour ce faire, modifiez l' Do While Trueinstruction en For clm = 2 to cel.EntireRow.Cells.Count, modifiez l' Loopinstruction en Next, remplacez les deux Exit Doinstructions par Exit Foret supprimez l' clm = clm + 1instruction.
Jason Clement
Bonjour encore une fois Jason, je calcule maintenant le pourcentage de correspondance entre le titre et la colonne B en utilisant le code ci-dessous. Cependant, je ne pouvais pas obtenir le numéro exact du mot dans la colonne A et le nombre exact de mots correspond à la colonne B. Pourriez-vous s'il vous plaît vérifier le code et me corriger si je me trompe.
Linga
0

Sub percentage()

Dim a() As String Dim b() As String Dim aRng As Range Dim cel As Range Dim i As Integer, t As Integer, clm As Integer Set aRng = Range(Range("A1"), Range("A65536").End(xlDown))

For Each cel In aRng a = Split(cel, " ") b = Split(cel.Offset(, 1), " ") d = 0 clm = 2 C = UBound(a) If cel.Value <> "" Then For i = LBound(a) To UBound(a)

        For t = LBound(b) To UBound(b)
            If UCase(a(i)) = UCase(b(t)) Then
                clm = 2
             Do While True
                If UCase(cel.Offset(, clm)) = UCase(a(i)) Then
                Exit Do
                End If
                    If cel.Offset(, clm) = "" Then
                        'cel.Offset(, clm) = a(i)
                        Exit Do
                    End If
                    clm = clm + 1
                Loop
                d = d + 1
            End If

        Next

Next

`MsgBox" Nombre total de mots "& C &" Mots correspondants "& d 'cel.Offset (0, 2) .Value = (d / c) End If Next

End Sub`

Linga
la source