Boucle de recherche pour remplissage colonne

Le 18/02/2021 à 11:59

bonjour,

je suis à recherche d'une âme charitable qui pourra m'aider à résoudre mon problème.

Je cherche à completer automatiquement. J' ai commencé un bout de code. Il fonctionne partiellement. Une partie seulement des lignes est remplies. Je n'arrive pas à voir ce qui cloche.

Principe:

En partant de la premiere valeur de la colonne H j'aimerai pouvoir rechercher la prochaine valeur identique et reporter en colonne J la valeur de la colonne B correspondante.

mon fichier et mon bout de code

Comme vous pouvez- le voir mon code saute des lignes colonne VBA. Il ne remplie pas les cellules en bleue.

Pouriez-vous svp m'aider à regler mon pb.

Cordialement,

hM

Sub next_prod()

Dim a As Integer, i As Integer, j As Integer, p As Integer, b As Integer, db As Long

db = Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To db
    a = 0
    p = 0
    For j = i + p To db
        If Range("H" & i) = Range("H" & j) Then
            a = a + p
            If a = p Then
                p = j
            End If
        End If
    Next j
    If a > 0 Then
        Range("J" & i).Value = Range("B" & p).Value
    Else
        Range("J" & i).Value = ""
    End If
    Next i

End Sub

9recherche-prod-suivante.xlsm (33.03 Ko)

Le 18/02/2021 à 12:16

Bonjour,

Voici un essai en utilisant les fonctions INDEX EQUIV et NB.SI (pour contrôler l'existence) :

Sub next_prod()

set wf = worksheetfunction

with activesheet
    dl = .Range("H" & .Rows.Count).End(xlUp).Row
    For i = 2 To dl
        if wf.countif(.range("H" & i + 1 & ":H" & dl), .cells(i, 8).value) > 0 then
            snom = wf.index(.range("B" & i + 1 & ":B" & dl), wf.match(.cells(i, 8).value, .range("H" & i + 1 & ":H" & dl),0))
            .Range("J" & i).Value = snom
        Else
            .Range("J" & i).Value = ""
        End If
    Next i
end with

End Sub

Cdlt,

Le 18/02/2021 à 12:25

Merci 3GB pour cette réponse rapide.

Je ne doute pas du fonctionnent de ton code, cependant j’obtiens exactement le meme résultat.

Les memes lignes restent vide.

C'est à n'y rien comprendre

hm

Le 18/02/2021 à 12:31

Merci de m'accorder ta confiance !

Je n'avais pas fait attention mais il y a des lignes fusionnées apparemment ?! Oulala, c'est très mal !

La meilleure solution consisterait à les défusionner.

Edit : A essayer quand même :

Sub next_prod()

set wf = worksheetfunction

with activesheet
    dl = .Range("H" & .Rows.Count).End(xlUp).Row
    For i = 2 To dl
        if wf.countif(.range("H" & i + 1 & ":H" & dl), .cells(i, 8).value) > 0 then
            lpos = wf.match(.cells(i, 8).value, .range("H" & i + 1 & ":H" & dl),0)
            snom = .cells(i + lpos, 2).mergearea(1).value
            .Range("J" & i).Value = snom
        Else
            .Range("J" & i).Value = ""
        End If
    Next i
end with

End Sub

Le 18/02/2021 à 12:51

Bien vu. Effectivement j'ai fait cette erreur.

Je viens de dé-fusionner toutes mes cellules.

Voici le resultat.

C’était mieux avant