XL 2016 recherche mot exact

[Frank Bellaisch]

Bonjour à tous et merci d'avance à ceux qui pourront m'aider.

Sur le tableau ci-joint, je dois calculer des sommes selon les années et un code spécifique. J'ai écrit une formule mais la recherche par mot ne se fait pas sur le mot exact. Donc si je cherche R1, il va prendre R11, R12 etc etc ce que je ne veux pas.
Je suis totalement bloqué.
Merci de vos conseils.
bonne journée

 

[Frank Bellaisch]

C'est parfait, ça fonctionne nickel.
Vous avez raison, plus c'est tordu plus il faut VBA. Mais c'est ma grosse lacune
encore merci

 

[job75]

Dans la vraie vie :

- combien de cellules à remplir dans votre 1er tableau ?

- combien de lignes peut faire votre 2ème tableau ?

 

[Frank Bellaisch]

Mon tableau a en théorie un nombre de lignes illimité car il se remplit au fur et à mesure que nous faisons enlever nos déchets. En revanche, je n'ai qu'un seul tableau.
Encore merci

 

[job75]

Pouvez-vous être plus précis ?

Le fichier que vous avez présenté a 2 tableaux : C4: D6 et B12:E34.

La durée d'exécution de la macro est proportionnelle au nombre de cellules du premier et au nombre de lignes du second.

Combien de valeurs comme R1 sont recherchées en général et combien d'années pour le 1er ?

 

[Frank Bellaisch]

Ok j'ai compris. Cela dit, j'ai tenté de placer la macro sur mon fichier original (sans succès, ce qui n'est pas étonnant ). Cela m'ennuie de l'envoyer sur ce forum, Pouvons nous poursuivre cette discussion en dehors ? Je pourrais vous envoyer le fichier original. Merci

 

[job75]

Pourquoi ne répondez-vous pas aux questions posées ?

Pas question de communiquer en dehors du forum, déposez un fichier anonymisé.

Cela dit ce qui prend beaucoup de temps c'est l'instruction InStr(Q(k, 2).Text, P(1, j))

Avec ce fichier (3) et ce code la durée d'exécution est divisée par 3 :

Sub MAJ()
Dim P As Range, Q As Range, i&, j%, k&, v1, v2, n%
Set P = [B3].CurrentRegion
Set Q = [B11].CurrentRegion
Application.ScreenUpdating = False
For i = 2 To P.Rows.Count
    For j = 2 To P.Columns.Count
        P(i, j) = ""
        For k = 2 To Q.Rows.Count
            If (Q(k, 2) = P(1, j) Or Year(Q(k, 2)) = P(1, j)) And P(1, j) <> "" Then
                v1 = Q(k, 3).MergeArea(1) 'en cas de cellule fusionnée
                If IsNumeric(CStr(v1)) And P(i, 1) <> "" Then
                    v2 = Q(k, 4).MergeArea(1) 'en cas de cellule fusionnée
                    n = InStr(v2, P(i, 1))
                    If n Then If Not IsNumeric(Mid(v2, n + Len(P(i, 1)), 1)) _
                        Then P(i, j) = P(i, j) + v1
                End If
            End If
Next k, j, i
End Sub

 

[Frank Bellaisch]

bonjour, pas de souci, c'était une proposition. Voici le fichier anonymisé, j'ai laissé les données qui nous intéressent mais le nombre de lignes et les colonnes sont dans leur intégralité.
merci

 

[job75]

C'est vraiment n'importe quoi, il y a des trous partout et plus du tout de cellules fusionnées.

J'ai quand même adapté la macro :

Sub MAJ()
Dim P As Range, Q As Range, Pcc%, Qrc&, i&, j%, k&, v1, v2, n%
Set P = [F5:I7] 'à adapter
Set Q = Range("F14:I" & Range("F" & Rows.Count).End(xlUp).Row) 'à adapter
Pcc = P.Columns.Count
Qrc = Q.Rows.Count
Application.ScreenUpdating = False
For i = 1 To P.Rows.Count
    For j = 1 To Pcc
        P(i, j) = ""
        If P(i, 0) <> "" And P(0, j) <> "" Then
            For k = 2 To Qrc
                If (Q(k, 1) = P(0, j) Or Year(Q(k, 1)) = P(0, j)) Then
                    v1 = Q(k, 2).MergeArea(1) 'en cas de cellule fusionnée
                    If IsNumeric(CStr(v1)) Then
                        v2 = Q(k, 4).MergeArea(1) 'en cas de cellule fusionnée
                        n = InStr(v2, P(i, 0))
                        If n Then If Not IsNumeric(Mid(v2, n + Len(P(i, 0)), 1)) _
                            Then P(i, j) = P(i, j) + v1
                    End If
                End If
            Next k
        End If
Next j, i
End Sub

 

[Frank Bellaisch]

Oui, j'ai été obligé de créer un nouveau tableau car le poids était supérieur à 1Mo et le forum m'interdisais de poster. J'ai essayé de compresser sans succès. Du coup, en copiant collant, les cellule fusionnées ont disparu et je n'ai pas corrigé. Toutes mes excuses. Merci pour votre travail.

 

[Frank Bellaisch]

Les trous, c'est à cause des cellules fusionnées qui ne le sont plus ou parce que les données me parviennent avec un délai entre l'enlèvement des déchets et la réception du document du collecteur.

 

[job75]

Vu le peu de lignes ce n'était pas grand-chose de refusionner les cellules pour que ca ressemble bien à l'original.

Et pourquoi les cellules vides en F4 et H4 ???

 

[Frank Bellaisch]

parce qu'il y avait des colonnes masquées (pour être totalement transparent, j'ai récupéré ce fichier d'une personne qui a quitté la société) et je n'ai pas eu le temps de remettre tout à plat