Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Correction d'un code vba

A

AD95

XLDnaute Junior
Bonjour la team,

Tout d'abord, merci d'avance pour votre aide.
Voilà j'ai un problème avec mon code il ne fait pas exactement ce que je veux

Voici mon besoin :

1 ==> A partir de la 12 -ème feuille si colonne A contient le chiffre "0" alors copier toute la ligne
2 ==>Coller les lignes dans la feuille All_Name (Coller à la dernière ligne)
3 ==> Supprimer toutes les colonnes sauf :
Colonne C ==> Classe
Colonne F ==> 1C
Colonne G ==> 2C
Colonne I ==> 4C
Colonne J ==> 5C
Colonne R ==> 3C

4. Si colonne A contient doublon alors supprimer la ligne en doublon (doit rester qu'une valeur unique)

5. Ajouter 2 colonnes et nommer
Entity
Product Line

6. Agencer/Renommer les colonnes
Colonne A ==> ID
Colonne B ==> Nom
Colonne C ==> Prenom
Colonne D ==> Entity
Colonne E ==> Contract
Colonne F ==> Product Line
Colonne G ==> Manager
Colonne R ==> Start Date


Le problème c'est qu'il me copie pas que la ligne qui contient "0" et supprime pas que la ligne en doublon je vois pas où se trouve l'erreur dans le code
 

Pièces jointes

  • externes-avec-0-aléatoire.xlsm
    49.9 KB · Affichages: 6
Solution
ho puré de puré de puré de puré de puré
je viens de m'en rendre compte moi aussi
l'erreur est simple
Set RnG = SH.Range("A 2/1 :AA" & SH.Cells(Rows.Count, 2).End(xlUp).Row - 1) 'on prend toute la
Cliquez pour agrandir...


VB: 
Option Explicit
Sub testX()
    Dim colonne, SH, A&, MsG$, LiG&, RnG, TotaL&, TabLresulT, I&
    colonne = Array( 2, 3, 6, 7, 1, 10, 1, 9)   'matrice de colonne
    Sheets("All_Name").Cells.Clear                                                                                      ' vide la feuille All_Name
    DoEvents
    Application.ScreenUpdating = False
    For I = 13 To Sheets.Count...
Trier par date Trier par votes

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @ad95 ,

J'ai un petit sentiment de malaise :
  • vous parlez de "mon code". Ne serait-ce pas plutôt celui de patrickT ici sur XLP ?
  • sur XLP, vous êtes l'auteur d'un fil sur lequel patrickT a consacré beaucoup de temps à vous concocter une solution. Pourquoi aller faire "corriger" ce code sur un autre forum dans une autre discussion ?
  • j'espère que le membre de XLD "patricktoulon" ne tombera pas sur ce fil, car il risque de nous faire une violente syncope .
 
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
@mapomme si c'est bien ça mais j'ai pas trop envie de l'embêter justement il a passer du temps dessus et je lui en remercie infiniment mais j'arrive pas à trouver le problème de son côté ça fonctionne bien mais pas chez moi je veux pas continuer à l'agacer je l'ai déjà trop soulé .

(j'ai mis mon code car j'ai fait un copier/coller car j'avais mon code à la base mais il était très lent et le but était justement de le modifier pour le rendre plus rapide. Son code est riche et j'essaie de le comprendre justement
 
Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Dans ce cas :

Avec votre explication, patrickT (sur XLP) ou patricktoulon (sur XLD) pourrait éventuellement comprendre votre démarche. Quand on explique, on est amené à comprendre, voire à excuser.

Mais un laconique "il ne fait pas exactement ce que je veux" sans dire explicitement ce qu'il ne fait pas ou ce qu'il ne fait pas comme vous le voudriez n'est d'aucune utilité pour vous répondre. Il faut aller dans les détails.
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re
bonsoir Ad95
mon code marche parfaitement bien avec d'autres feuilles que j'ai faite moi même
si des cellules avec 1 sont prises quand même ca viens de tes feuilles qui affiche ce qui n'est pas

d'autre part le crossposting est mal vu
comprends bien que si quelqu'un se casse la tête pour toi et que tu va chercher bonheur ailleurs
et que si solution trouvé ailleurs ton post sur XLP restera non résolu
ou inversement
et maintenant à ce que je vois il y a une colonne supplementaire la R
il faudrait peut $etre donner tout les élements d'un coup
 
Dernière édition:
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
Re patricktoulon,

oui bien sûr je t'ai envoyé un message de remerciement justement et je voulais pas abusé de ton temps, c'est pour avoir un œil nouveau que je demande ici car comme je t'ai dit je trouve pas mon erreur sur la feuille j'ai passé la nuit à chercher et tester alors que chez toi ça fonctionne (c'est ça qui me rend dingue )le code est excellent car très rapide contrairement au mien.
Je t'ai envoyé un message pour t'informer que je vais me renseigner droite à gauche pour voir et si je trouve mon problème je l'aurai partagé pour t'en informé aussi le but est de partager aussi pour les autres si ça peux servir donc je l'aurai fait et mis en résolu par la suite (c'est pour ça que je l'ai pas encore fait)
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
la raison je te l'ai donné
c'est tes feuilles qui partent en vrille
il y a "1" dans la cellule mais quoi que je fasse vba l'identifie comme "0"


VB: 
if val(sh.cells(lig,"A")) =0 and sh.cells(lig,"A")<>"" then
prend quand même la ligne avec "1"



VB: 
if trim(sh.cells(lig,1).text)="0"
prend quand même la ligne avec "1"

d'autant plus qu'il n'y a pas que ces lignes qui ont 1
alors pose toi la question et surtout dans le bon sens

la question qui va allumer tout les ampoules dans ta tête
pourquoi certaines lignes avec "1" passent Alors d'autres sont bien exeptées

si je te dis que tes feuilles sont pourries c'est quelles sont pourries !!
j'ai passé des heures avant d'abandonner et d'en conclure que ca ne pouvait être que tes feuilles qui flipent
 
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Chez moi aussi ça semble ne pas fonctionne.

J'ai corrigé trois choses et ça semble mieux fonctionner, mais je ne suis pas sûr, donc c'est à vérifier.
 

Pièces jointes

  • externes-avec-0-aléatoire.xlsm
    54.2 KB · Affichages: 2
Dernière édition:
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Est-ce que ce n'es pas plutôt parce que tu te décales d'une ligne en commençant les tests à partir de la ligne n° 1 de chaque feuille, qui est en fait la ligne d'en-tête du tableau ?

Si ce n'est pas ça, patapay, je n'ai pas passé des heures à chercher, mais seulement 5 minutes.
 
Dernière édition:
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
bonsoir garçon trop gros(pas pire que moi)
je décale rien
VB: 
 For LiG = 1 To SH.Cells(Rows.Count, 2).End(xlUp).Row                                                          'boucle de la ligne 1 à la dernière
            If Val(SH.Cells(LiG, "A")) = 0 And SH.Cells(LiG, "A") <> "" Then                                          'si la condition est remplie
                A = A + 1: ReDim Preserve arrligne(1 To A): arrligne(A) = LiG                                         'on incrémente la matrice de ligne et on y intègre l'index de ligne "lig"
            End If
        Next
je teste la ligne 1 je pourrais m'en passer mais je ne decale rien
la variable A c'est l'index du tableau arrlig qui n'a rien a voir avec le numero de ligne
donc non je décale pas

de toute facon j'ai testé avec des feuilles que j'ai fais moi même avec des noms et la colonne A avec des chiffres de 0 à 9 et je ne récupère rien d'autre que les zero
conclusion je le redis ces feuilles sont pourries
point barre
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
ho puré de puré de puré de puré de puré
je viens de m'en rendre compte moi aussi
l'erreur est simple
Set RnG = SH.Range("A 2/1 :AA" & SH.Cells(Rows.Count, 2).End(xlUp).Row - 1) 'on prend toute la
Cliquez pour agrandir...


VB: 
Option Explicit
Sub testX()
    Dim colonne, SH, A&, MsG$, LiG&, RnG, TotaL&, TabLresulT, I&
    colonne = Array( 2, 3, 6, 7, 1, 10, 1, 9)   'matrice de colonne
    Sheets("All_Name").Cells.Clear                                                                                      ' vide la feuille All_Name
    DoEvents
    Application.ScreenUpdating = False
    For I = 13 To Sheets.Count                                                                                         'boucle de 13 à sheets.count
        ReDim arrligne(1 To 1)                                                                                         'on redim la matrice de ligne a chaque feuille
        Set SH = Sheets(I)
        A = 0
      
        For LiG = 1 To SH.Cells(Rows.Count, 2).End(xlUp).Row                                                          'boucle de la ligne 1 à la dernière
            If Val(SH.Cells(LiG, "A")) = 0 And SH.Cells(LiG, "A") <> "" Then                                          'si la condition est remplie
                A = A + 1: ReDim Preserve arrligne(1 To A): arrligne(A) = LiG                                         'on incrémente la matrice de ligne et on y intègre l'index de ligne "lig"
           If LiG < 20 Then Debug.Print "ligne " & LiG & "   " & SH.Cells(LiG, 1) & "---" & SH.Cells(LiG, 2)
        
           End If
        Next
        MsG = MsG & SH.Name & " copie= " & A & " ligne(s)" & vbLf                                                     'on ajoute au texte du message
        TotaL = TotaL + A                                                                                             'on calcule le total de lignes
        Set RnG = SH.Range("A1:AA" & SH.Cells(Rows.Count, 2).End(xlUp).Row - 1)                                       'on prend toute la plage
        TabLresulT = Application.Index(RnG.Value, Application.Transpose(arrligne), colonne)                           'récupération du tableau selon la matrice de ligne et colonne
        With Sheets("All_Name").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            .Resize(UBound(arrligne), UBound(colonne) + 1) = TabLresulT                                               'injection du tableau dans la ligne dispo a partir d'en bas
        End With
    Next
    With Sheets("All_Name")
        'suppression des doublons
        .Range("$A$1:$AA$" & .Cells(Rows.Count, "a").End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo         'suppression des doublons
        TotaL = .Cells(Rows.Count, "B").End(xlUp).Row                                                                 'total des ligne récupérées

        .Columns(1).Delete
        'Suppression des colonnes non utilisées
        .Range("d:d,f:f").Clear                                                                                       'vidage des colonne que l'on a récupéré et qui sont les colonnes ajoutées


        'Nommer les Entêtes
        .Range("A1").Resize(, 7) = Array("ID", "Nom", "Prenom", "Entity", "contract", "Product line", "manager")    'Entêtes de colonne




        'design du tableau
        '***********************************************************
        'soit en range
        ' With .Range("A1:H" & .Cells(Rows.Count, 1).End(xlUp).Row)
        '    With .Rows(1)
        '   .Interior.Color = RGB(0, 0, 255)    ' Bleu
        '       .Font.Color = RGB(255, 255, 255)    ' Blanc
        '      .Font.Bold = True
        '  End With
        '  .HorizontalAlignment = xlCenter
        '  .VerticalAlignment = xlCenter

        '.Borders(xlEdgeLeft).LineStyle = xlContinuous
        ' .Borders(xlEdgeTop).LineStyle = xlContinuous
        '.Borders(xlEdgeRight).LineStyle = xlContinuous
        ' .Borders(xlEdgeBottom).LineStyle = xlContinuous
        '.Borders(xlInsideVertical).LineStyle = xlContinuous
        '.Borders(xlInsideHorizontal).LineStyle = xlContinuous
        ' End With
        '*********************************************************

        'ou tout simplement en listobject(tableau structuré)

        .ListObjects.Add(xlSrcRange, .Range("A1:G" & .Cells(Rows.Count, 1).End(xlUp).Row), , xlYes).Name = "Tableau1"
        '*************************************************
        [A1].Select
.Shapes("bouton").Left = 550
     End With


    MsgBox MsG & vbCrLf & "Pour un total de " & TotaL & " lignes" & vbCrLf & " en ayant supprimé les doublons "
    Application.ScreenUpdating = True
End Sub
donc autant pour moi méacoulpa je me suis énervé pour rien
donc @AD95 tu a droit à toutes mes excuses c'est bien une petite erreur de ma part

puré de puré de puré de puré !!!! un 2 à la place d'un 1
et je tourne comme un fou depuis hier


et travail fini ca donne ça
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
A

AD95

XLDnaute Junior
Bonjour la team,

@TooFatBoy @patricktoulon Mille merci ça marche nikel enfin je devenais dingue à pas trouver l'erreur chez moi @patricktoulon y a pas à s'excuser déjà que tu m'aide je suis trop novice encore pour tout capter j'ai encore du boulot pour arriver à votre niveau.

Un grand grand merci à vous je vais pouvoir dormir ce soir !!!!!!!!!!!!!!


Si je peux me permettre pour ne pas galérer dans la maintenance, qu'es que je doit modifier si jamais mon besoin évolue (car il va évoluer dans le temps avec 1 modification) ?

je vais rajouter 2 lignes (donc début des données en lignes 4) où je doit apporter une modification

Comme ceci :


J'ai fait le test sur mon fichier mais il prend la 1ère ligne comment lui dire de commencer par la 4ème ligne ?
 
Dernière édition:
Vote positif 0 Vote négatif
A

AD95

XLDnaute Junior
Voici la réponse de patricktoulon:

VB: 
Option Explicit
Sub testX()
    Dim colonne, SH, A&, MsG$, LiG&, RnG, TotaL&, TabLresulT, I&, plus
    colonne = Array(2, 3, 6, 7, 1, 10, 1, 9)    'matrice de colonne
    With Sheets("All_Name"): .Range("A5:AA" & .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row).Clear: End With                                                                                   ' vide la feuille All_Name
    DoEvents
    Application.ScreenUpdating = False
    For I = 13 To Sheets.Count                                                                                         'boucle de 13 à sheets.count
        ReDim arrligne(1 To 1)                                                                                         'on redim la matrice de ligne a chaque feuille
        Set SH = Sheets(I)
        A = 0

        For LiG = 4 To SH.Cells(Rows.Count, 2).End(xlUp).Row                                                          'boucle de la ligne 1 à la dernière
            If Val(SH.Cells(LiG, "A")) = 0 And SH.Cells(LiG, "A") <> "" Then                                          'si la condition est remplie
                A = A + 1: ReDim Preserve arrligne(1 To A): arrligne(A) = LiG                                         'on incrémente la matrice de ligne et on y intègre l'index de ligne "lig"
            End If
        Next
        MsG = MsG & SH.Name & " copie= " & A & " ligne(s)" & vbLf                                                     'on ajoute au texte du message
        TotaL = TotaL + A                                                                                             'on calcule le total de lignes
        Set RnG = SH.Range("A1:AA" & SH.Cells(Rows.Count, 2).End(xlUp).Row - 1)                                       'on prend toute la plage
        TabLresulT = Application.Index(RnG.Value, Application.Transpose(arrligne), colonne)                           'récupération du tableau selon la matrice de ligne et colonne
        If I = 13 Then plus = 0 Else plus = 1
        With Sheets("All_Name").Cells(Rows.Count, 1).End(xlUp).Offset(1 + plus)
            .Resize(UBound(arrligne), UBound(colonne) + 1) = TabLresulT                                               'injection du tableau dans la ligne dispo a partir d'en bas
        End With
    Next
     With Sheets("All_Name")
        'suppression des doublons
        .Range("A:AA").RemoveDuplicates Columns:=1, Header:=xlYes          'suppression des doublons
        TotaL = .Cells(Rows.Count, "B").End(xlUp).Row                                                                 'total des ligne récupérées

        .Columns(1).Delete
        'Suppression des colonnes non utilisées
        .Range("d:d,f:f").Clear                                                                                       'vidage des colonne que l'on a récupéré et qui sont les colonnes ajoutées

        'Nommer les Entêtes
        .Range("A1").Resize(, 7) = Array("ID", "Nom", "Prenom", "Entity", "contract", "Product line", "manager")    'Entêtes de colonne

        .ListObjects.Add(xlSrcRange, .Range("A1:G" & .Cells(Rows.Count, 1).End(xlUp).Row), , xlYes).Name = "Tableau1"
        '*************************************************
        ' .Rows("1:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        With ActiveWindow: .SplitColumn = 0: .SplitRow = 1: .FreezePanes = True: End With
        [A1].Select
        With .Shapes("bouton"): .Left = 550: .Top = 100: End With

        '*********************************************************************************

    End With

    MsgBox MsG & vbCrLf & "Pour un total de " & TotaL & " lignes" & vbCrLf & " en ayant supprimé les doublons "
    Application.ScreenUpdating = True
End Sub



Merci pour ton retour. J'ai fini mes tests voici le résultat

Mon code :


Ton code Code :


Clairement y ' a pas photo ton code est une aussi rapide que l'éclaire

Désolé encore pour XLD j'ai vue ta petite note


mais je trouvais pas l'erreur chez moi alors que chez toi ça fonctionné il me fallait un œil nouveau pour m'éclairer .

Tout ça à cause d'un 2 à la place du 1 je suis pas près de l'oublier

@patricktoulon @TooFatBoy @mapomme Merci merci infiniment pour votre aide et votre expertise !!!!!!!!!!


Bonne journée à tous !!!!!!!!!!!!!!!
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

A
  • Résolu(e)
Microsoft 365 Correction du code vba
Réponses
5
Affichages
452
AD95
A
J
  • Résolu(e)
Microsoft 365 [RESOLU] VBA boucle, insertion plusieurs lignes, exécution formules, suppression sur si
Réponses
5
Affichages
430
Phil69970
L
  • Question
XL 2016 correction d'un code VBA
Réponses
7
Affichages
563
LAPIN-53
L
G
  • Question
Microsoft 365 Export données d'une listview
Réponses
5
Affichages
442
GClaire
G
E
  • Résolu(e)
Microsoft 365 Problème d'organisation des colonnes dans une ListBox en VBA Excel
Réponses
2
Affichages
797
eCHO
E
L
  • Résolu(e)
Microsoft 365 Mise en forme d'un tableau via VBA
2 3
Réponses
41
Affichages
2 K
Hasco
D
  • Question
XL 2016 Insertion de lignes conditionnée
Réponses
1
Affichages
418
Hasco
D
  • Question
XL 2019 Aide à la compréhension d'un code VBA
Réponses
4
Affichages
972
Dudu2
A
  • Question
Microsoft 365 VBA code pour inserer des lignes une condition
Réponses
4
Affichages
715
AEz
A
P
  • Résolu(e)
Microsoft 365 Passer des lignes quand une condition est remplie en Macro
Réponses
11
Affichages
1 K
sylvanu
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…