Problème programme VBA ne marche qu'aux 3 quarts

deepsoul94

XLDnaute Nouveau
Bonsoir,

Je m'adresse à vous dans l'espoir que vous puissiez m'aider car je viens de m'arracher les cheveux toute la journée à essayer de comprendre pourquoi mon programme VBA ne marchait qu'aux 3 quarts.

Le fichier (ci-joint) est composé de deux onglets. Par soucis de confidentialité j'ai remplacé les noms qui n'intervenaient pas dans le programme par des XXX.

Le premier onglet (listing mediapeers _ (2)) ( est une liste dont les colonnes sont à compléter en allant chercher l'information dans le deuxième onglet (cat_2 (2)) qui est une extraction directe d'un logiciel dont j'ai oublié le nom.

Le but du programme est de récupérer les informations "langues de sous titrage" et "synopsis court" et "synopsis long"

Les données sont triées par numéro d'identification, par ordre décroissant.

Le programme s’exécute jusqu'au bout, mais quand je vérifie le résultat, à partir de la ligne 563 les colonnes pour les sous titres n'ont plus été complétées alors que l'information est bien présente dans l'onglet

J'ai pensé que c'était dû à une erreur de logique dans le traitement des variables, mais si celles ci se décalaient, les remplissage de l'indication de langue de sous titres serait faux or ce n'est pas le cas.


Voici le code

Code:
Sub remplissage()

Dim i, r As Integer
Dim b As Boolean

'b va servir à indiquer si la ligne i a déjà été remplie (partiellement ou totalement)

Application.ScreenUpdating = False

'initialisation des variable pour la première ligne de chaque onglet qui contient les données
i = 5
r = 5
b = False

'on répète l'opération jusqu'à ce qu'il n'y ai plus de code identifiant
Do While IsEmpty(Sheets("cat_2 (2)").Cells(r, 4)) = False

'on s'assure ensuite que l'identifiant de la ligne qu'on veut remplir est bien présent dans l'onglet cat_2
   If Sheets("cat_2 (2)").Range("D5:D3877").Find(what:=Sheets("Listing_Mediapeers (2)").Cells(i, 1).Value) Is Nothing Then

    i = i + 1
    
   Else

's'il est présent, on veut trouver la cellule d'identifiant de cat 2 égale à la cellule d'identifiant de listing
        If Sheets("cat_2 (2)").Range("d" & r) = Sheets("Listing_Mediapeers (2)").Range("A" & i) Then
        
        b = True
            'on veut récupérer l'information sur le descriptif en anglais du programme
            If IsEmpty(Sheets("Listing_Mediapeers (2)").Cells(i, 19)) = True And IsEmpty(Sheets("Listing_Mediapeers (2)").Cells(i, 20)) Then
            Sheets("Listing_Mediapeers (2)").Cells(i, 19) = Sheets("cat_2 (2)").Cells(r, 10)
            Sheets("Listing_Mediapeers (2)").Cells(i, 20) = Sheets("cat_2 (2)").Cells(r, 11)
            End If
            
            'on veut ensuite que la langue indiquée dans l'onglet cat 2 amène à mettre un 1 dans la colonne correspondante dans l'onglet Listing
            If IsEmpty(Sheets("cat_2 (2)").Cells(r, 7)) = False Then
            Sheets("Listing_Mediapeers (2)").Cells(i, Application.WorksheetFunction.Match(Sheets("cat_2 (2)").Cells(r, 7), Sheets("Listing_Mediapeers (2)").Range("A2:O2"), 0)) = 1

            ' et ensuite on passe à la ligne suivante dans l'onglet cat 2
            End If
            r = r + 1

        Else

    'si les deux cellules n'étaient pas égale:
            ' si la cellule de listing a été complétée, ...
            If b = True Then
            
            '...cela signifie qu'il faut passer à la cellule suivante dans Listing
            i = i + 1
            b = False

            'si la cellule de listing n'a pas été complétée, alors c'est qu'il faut passer à la cellule suivante dans cat 2
            Else: r = r + 1

            End If

        End If


    End If
    
Loop

Sheets("Listing_Mediapeers (2)").Cells(1, 1) = r
Sheets("Listing_Mediapeers (2)").Cells(1, 2) = i
Application.ScreenUpdating = True

End Sub

et le fichier en pièce jointe.

J'espère que quelqu'un aura la gentillesse de m'aider!

bonne soirée.
 

Pièces jointes

  • Listing_Mediapeers epuré recherche problème.xlsx
    239.3 KB · Affichages: 79

porcinet82

XLDnaute Barbatruc
Re : Problème programme VBA ne marche qu'aux 3 quarts

Hello,

Modifie la ligne de code
Code:
Sheets("cat_2 (2)").Range("D5:D3877").Find(what:=Sheets("Listing_Mediapeers (2)").Cells(i, 1).Value) Is Nothing Then
par
Code:
If Sheets("cat_2 (2)").Range("D5:D" & Sheets("cat_2 (2)").Range("D65536").End(xlUp).Row).Find(what:=Sheets("Listing_Mediapeers (2)").Cells(i, 1).Value) Is Nothing Then

@+
 

deepsoul94

XLDnaute Nouveau
Re : Problème programme VBA ne marche qu'aux 3 quarts

Ok... J'ai perdu un après midi entier juste par ce que j'ai pris le nombre de ligne d'un fichier Excel que j'avais au préalable un peu élagué et que je n'ai même pas fait gaffe qu'ensuite je m'étais mis à coder sur le fichier source... Grande leçon d'aujourd'hui, utiliser end Xl up ou down à chaque fois.


Merci beaucoup en tous les cas porcinet 82 !
Y a t-il un bouton "résolu" ou "conversation terminé" à cocher?

bonne journée.
 

Discussions similaires

Réponses
5
Affichages
190
Réponses
5
Affichages
242

Statistiques des forums

Discussions
312 225
Messages
2 086 412
Membres
103 202
dernier inscrit
Claire2BM