XL 2016 VBA Synthèse Classeur Volumineux + Comparaison

[scalaze]

Bonjour,

J'ai 2 classeurs composés de plusieurs onglets avec données de +- 5000 mille lignes.
Je souhaite réaliser une feuille Regroupement de ses feuilles pour chaque classeur.
Je n'ai pas vraiment de connaissance en VBA mais après lecture sur ce forum , j ai trouvé ce code qui correspond à ma première demande mais il ne prend qu'une partie de mes onglet avec un temps assez long puis un message d'erreur apparait j = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1.

Option Explicit

Sub Transfert()
Dim Ws As Worksheet, Wd As Worksheet, Dl%, i%, j%
Application.ScreenUpdating = False
Range("A2:F65000").Clear

Set Wd = Sheets("regroupement")
j = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1
  For Each Ws In Worksheets
    If Ws.Name <> "regroupement" And Ws.Name <> "exclure" Then
    Sheets(Ws.Name).Activate
    Set Ws = Sheets(Ws.Name)
    Dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
      For i = 2 To Dl
          Wd.Cells(j, 1).Value = Ws.Name
          Ws.Range(Cells(i, 1), Cells(i, 5)).Copy Wd.Cells(j, 2)
          j = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1
      Next i
      End If
  Next Ws
  Sheets("regroupement").Activate
  Range("A2").Select
  Application.ScreenUpdating = True
End Sub

Mon projet initial est de comparer les Envoi Général avec mon classeur Vente Général et inversement.
Tous les mois, je reçois un fichier de ventes que je colle à mon classeur Vente Général pour effectuer le regroupement.
Tous les mois, j'extrais mes envois que je colle à mon classeur Envoi Général pour effectuer aussi le regroupement.

Mes ventes peuvent être réalisé le mois en cours ou ultérieur à +4 mois.

Mes 2 classeurs ne sont pas constitués de la même manière mais ont la même Donnée Ref2 à comparer sur la même colonne C

Le but ,comparer la colonne C - Ref2 de Envoi par rapport à Ventes , et généré une feuille récapitulatif des références non présente.
et inversement pour voir si il n'y a pas de doublon dans la synthèse vente.

Je ne sais pas si c est la bonne méthode ou le bon code pour mon projet, d'ailleurs, je compte sur vous pour me le dire.

En espérant avoir été clair dans mes écrits .

Mes fichiers étant trop volumineux ,je les ai compressé.

Je vous remercie par avance pour votre lecture et aide futur

Bien cordialement,


PS: Je travaille sur Excel 2016 mais mes collègues sur 2010

 

[cp4]

Bonjour,

Je n'ai pas bien compris tes attentes. Cependant, je peux te dire que ton code prendra beaucoup de temps car il effectue des copies lignes pas ligne. Si tu multiplies le nombre de lignes par le nombre de feuilles, ça te donnera une idée.

Le mieux est d'utiliser les tableaux (array). Le code ci-dessous transfert les données de toutes les feuilles vers la feuille "regroupement" très rapidement. Ensuite tu pourras traiter cette feuille à ta guise.

Option Explicit
Sub transfert2()
   Dim Ws As Worksheet, Wd As Worksheet, dl As Long, Tb(), j As Long, Tmois(), i As Integer, Tres()
   Set Wd = Sheets("regroupement")
   j = Wd.Range("A" & Rows.Count).End(xlUp).Row
   Wd.Range("A2:E" & j).Clear
   For Each Ws In Worksheets
      If Ws.Name <> "regroupement" Then
         dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
         j = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1
         Tb = Ws.Range("A2:E" & dl).Value
         ReDim Tmois(1 To UBound(Tb), 1 To 1)
         For i = 1 To UBound(Tb)
            Tmois(i, 1) = Ws.Name
         Next i
         Tres = MergeArrayHoriz(Tmois, Tb)
         Wd.Range("A" & j).Resize(UBound(Tres, 1), UBound(Tres, 2)) = Tres
      End If
   Next Ws
   Set Wd = Nothing: Erase Tb
End Sub
Function MergeArrayHoriz(Tab1, Tab2) 'http://boisgontierjacques.free.fr/pages_site/tableaux.htm#FusionHoriz
Dim ktab1 As Boolean, ktab2 As Boolean, col1 As Long, col2 As Long, lg As Long, c As Long, k As Integer
  On Error Resume Next
  ktab1 = True: col1 = UBound(Tab1, 2): If Err > 0 Then col1 = 1: ktab1 = False
  Err = 0: ktab2 = True: col2 = UBound(Tab2, 2): If Err > 0 Then col2 = 1: ktab2 = False
  On Error GoTo 0
  Dim b(): ReDim b(1 To UBound(Tab1), 1 To col1 + col2)
  For lg = LBound(Tab1, 1) To UBound(Tab1)
    For c = 1 To col1
      If ktab1 = True Then b(lg, c) = Tab1(lg, c) Else b(lg, c) = Tab1(lg)
    Next c
  Next lg
  k = col1
  For lg = LBound(Tab2, 1) To UBound(Tab2)
    For c = 1 To col2
      If ktab2 = True Then b(lg, c + k) = Tab2(lg, c) Else b(lg, c + k) = Tab2(lg)
    Next c
  Next lg
  MergeArrayHoriz = b
End Function

Bonne journée.

 

[scalaze]

Bonjour Cp4

Tout d'abord merci pour la lecture suite à ma demande.

J'ai testé ce code sur le fichier complet et c'est parfait.
Ta proposition me convient parfaitement. et merci pour le lien même si cela va me prendre du temps à la lecture et compréhension.

Pour éclairer ma demande ,

j'ai 2 classeurs dans le même dossier " Envoi Général " et "Vente Général"
avec comme point commun la colonne C " Ref2 ".(référence unique )

1 - Synthétiser les données sur "Recouvrement" sur les 2 classeurs.

2 - Sur la feuille "Control" du classeur Envoi Général ,
comparer les données et indiquer quelles sont les références non présentent,
par rapport à la synthèse Vente du classeur Vente Général.
Cela me permettra de savoir quel produit est toujours en vente.

3 - Sur la feuille "Control" du classeur Vente , idem que le classeur Envoi Général.
Comme mes références sont unique ,cela me permettra de savoir si un produit est vendu 2 fois.


Pour résume le point 2 , si la référence en C de la feuille Regroupement de Envoi est présent dans la feuille regroupement de ventes , on ne fait rien sinon on importe la donnée dans la feuille Control de Envoi.

Peux tu me dire pour toi, quel serait la méthode la plus approprié ?

Merci

 

[cp4]

Bonjour Scalaze,

Je n'ai encore ouvert tes derniers fichiers joints. Tu as essayé d'être un peu plus clair et souvent c'est la difficulté de se faire comprendre. Ce qui est évident pour toi ne l'est peut-être pas pour celui qui essaie d'aider.

Comme une image vaut mieux qu'un long discours. Je te dis ça pour faire la similitude avec tes fichiers.
En effet, rien ne sert de mettre des kilomètres de lignes pour tester un code. Il aurait été plus avantageux pour tous d'avoir quelques lignes de données et de montrer le résultat escompté, ça sera plus explicite.

Bonne journée.

A+

edit: Je viens d'ouvrir tes fichiers et première difficulté les feuilles ne sont pas identiques (entêtes de colonnes)

 

[scalaze]

Bonjour Cp4

J'ai modifié les fichiers avec annotation , je croise les doigt cette fois ci.

Bien cordialement

 

[cp4]

Bonsoir,

Dans l'un des fichiers tu as fait une erreur, il ne reste que 2 références au lieu de 3.
Pour le second, c'est juste il ne reste qu'une référence.
Attention! les 2 fichiers doivent être ouverts.

'---------------------------------------------------------------------------------------
' LES 2 FICHIERS DOIVENT ÊTRE OUVERTS
' AVANT D'EXECUTER LE CODE ADAPTER LES NOMS DE FICHIERS WbVente et WbEnvoi
' CODE A METTRE DANS UN MODULE STANDARD DANS L'UN DES 2 FICHIERS
'---------------------------------------------------------------------------------------

Option Explicit
Sub Ouvre()
   Dim WbVente As Workbook, WbEnvoi As Workbook, Chemin As String, Fichier_à_ouvrir As String
   Dim Tev(), Tvt(), tv(), Dev As Object, Dvt As Object, i As Long, clé, n As Long, j As Byte

   Set Dev = CreateObject("scripting.dictionary")
   Set Dvt = CreateObject("scripting.dictionary")

   Set WbVente = Workbooks("Vente General Test V1.1.xlsm")
   Set WbEnvoi = Workbooks("Envoi General reduit V1.1.xlsm")

   Tev = WbVente.Sheets("Regroupement").Range("A1").CurrentRegion.Value2
   Tvt = WbEnvoi.Sheets("Regroupement").Range("A1").CurrentRegion.Value2

   For i = 2 To UBound(Tev)
      Dev(Tev(i, 3)) = ""   'reference sans doublon vente
   Next i

   For i = 2 To UBound(Tvt)
      Dvt(Tvt(i, 3)) = ""  'reference sans doublon envoi
   Next i

   For Each clé In Dev.keys
      For i = 0 To Dvt.Count - 1
         If Dvt.keys()(i) = clé Then
            Dvt.Remove (clé)   'on vire reference existantes
            Exit For
         End If
      Next i
   Next

   n = 0
   For Each clé In Dvt.keys
      For i = 1 To UBound(Tvt, 1)
         If Tvt(i, 3) = clé Then
            n = n + 1
            ReDim Preserve tv(1 To 6, 1 To n)
            For j = 1 To 6
               tv(j, n) = Tvt(i, j)   ' on alimente tableau des clées restantes
            Next j
         End If
      Next i
   Next

   With WbEnvoi.Sheets("Control")
      .Cells.Clear
      Sheets("Regroupement").Range("A1:F1").Copy .Range("A1")
      .Range("A2").Resize(UBound(tv, 2), UBound(tv, 1)) = Application.Transpose(tv)
      .Range("E2").Resize(UBound(tv, 2), 1).NumberFormat = "m/d/yyyy"
   End With

  ' on refait la même chose pour le fichier vente
   'on réalimente le dictionnaire reference vente
   For i = 2 To UBound(Tvt)
      Dvt(Tvt(i, 3)) = ""  'reference sans doublon envoi
   Next i
''****************************************************************
   For Each clé In Dvt.keys
Debug.Print clé
      For i = 0 To Dev.Count - 1
Debug.Print Dev.keys()(i)
         If Dev.keys()(i) = clé Then
            Dev.Remove (clé)   'on vire reference existantes
            Exit For
         End If
      Next i
   Next

   n = 0
   For Each clé In Dev.keys
      For i = 1 To UBound(Tev, 1)
         If Tev(i, 3) = clé Then
            n = n + 1
            ReDim Preserve tv(1 To 6, 1 To n)
            For j = 1 To 6
               tv(j, n) = Tev(i, j)   ' on alimente tableau des clées restantes
            Next j
         End If
      Next i
   Next

   With WbVente.Sheets("Control")
      .Cells.Clear
      Sheets("Regroupement").Range("A1:F1").Copy .Range("A1")
      .Range("A2").Resize(UBound(tv, 2), UBound(tv, 1)) = Application.Transpose(tv)
      .Range("E2").Resize(UBound(tv, 2), 1).NumberFormat = "m/d/yyyy"
   End With

   Set WbVente = Nothing: Set WbEnvoi = Nothing: Set Dev = Nothing: Set Dvt = Nothing
End Sub

En espérant que ça répond à tes attentes.

Bonne soirée.

 

[scalaze]

Bonsoir Cp4.

Dsl pour le retour tardif , j'étais en extérieure.

Je te remercie déjà pour l'aide et le temps passé pour ta proposition qui correspond à ma demande

Ma problématique par rapport à ta proposition et adaptation à mes classeurs d'origine avec données plus conséquente, j 'ai Excel qui ne réponds pas, obligé de le fermer avec le gestionnaire des taches.


- Les classeurs sont bien ouvert

- J'ai bien renommer les fichiers WbVente et WbEnvoi

- j'ai modifier mes noms de classeur original par rapport au code pour éviter toues modifications.

- Je les laissais tourner + 20mn


As tu une idée de la problématique ?

Merci

 

[cp4]

bonjour,

Je pense qu'il ne fallait pas renommer les fichiers en WbVente et en WbEnvoi.
Dans le code WbVente et WbEnvoi sont des variables représentant les classeurs.
Sinon, je ne sais pas ce que tu as fait dans tes fichiers.
En retour, voici les fichiers avec lesquels j'ai travaillé. J'espère que ça va t'aider.

Bon dimanche.

 

[scalaze]

Bonjour Cp4.

Pour éviter toute erreur, j 'ai repris tes fichiers et au lancement ,le job se fait.

J ai collé mes 12 feuilles dans ton fichier >>>>> Excel plante

Sur le code , j'ai bloqué la deuxième partie du code pour voir si la première demande se réaliser .

Puis, j'ai supprimer feuilles par feuilles et cela refonctionne avec 3 feuilles.


Pour faire simple .

12 feuilles >>Excel Plante

4 feuilles >>Excel Plante

3 Feuilles >>>>Excel ok


Si je débloque la deuxième partie avec 3 feuilles Excel plante.


As tu une idée de la problématique ?


Cdt

 

[cp4]

Bonjour,

Je suis dans l'incapacité de te répondre dans ces conditions. Il n'y a pas de raisons pour que les codes plantent si tes fichiers joints reflètent bien tes vrais fichiers.
Je t'ai proposé 2 codes. Le 1er contient une fonction de Boisgontier qui fusion des tableaux. En effet, vu le nombre de feuilles et de lignes, l'utilisation des tableaux est plus indiquée. une fois les données regroupées sur une feuille un 2ème code traite ces données.
Donc sans ton réel fichier (sans données confidentielles), je ne peux pas te proposer de solution.

Bonne journée.

edit: je viens de tester avec les fichiers du post#1, chez aussi c'est interminable. Ceci est dû au très grand nombre de données à traiter. Tu devrait passer à Access, c'est le plus indiqué pour les bases de données. Ou utiliser PowerQuery ou TCD.
Tu pourrais cibler les données tu as vraiment besoin pour les limiter au strict nécessaire.

 

[cp4]

Bonjour,

Étant donné que tu ne cherches que les références. Après avoir traité les feuilles "regroupement" individuellement. Sur ces dernières, il y aura les références sans doublons avec le nombre de fois acheter.
Ensuite clique sur le bouton de la feuille "control", tu auras les références comme tu le souhaitais.
Vu le nombre imposant de références, je te laisse le soin de vérifier que les résultats sont justes.
/!\ important: les 2 fichiers doivent être ouverts.

2 Fichiers trop volumineux (zip) à récupérer ICI

 

[scalaze]

Bonjour Cp4,

J'ai pris tes fichiers et mis mes données .

Pour le fichier Vente Général ,le regroupent correspond bien à l'ensemble de mes données mensuels >>>

Pour le fichier Envoi Général ,le regroupent correspond bien à l'ensemble de mes données mensuels mais une erreur apparait >> Erreur D'exécution 6 : Dépassement de capacité

Pour la comparaison entre les deux fichiers, le code se lance sans problème et me récupère les références souhaité mais il y a un mais DSL.

1 - Pour une meilleur analyse ,peut on mettre devant ou après le nom de la feuille correspondant à la référence trouver ?

2 - Mes références sont uniques et ils ne peuvent être vendu 2 fois, cela rejoint ma première demande.
Peut on mettre après le regroupement un message ou autre pour m'indiquer qu'il y a des doublons .


Bien cordialement

 

[cp4]

Bonjour Cp4,

J'ai pris tes fichiers et mis mes données .

Pour le fichier Vente Général ,le regroupent correspond bien à l'ensemble de mes données mensuels >>>

Pour le fichier Envoi Général ,le regroupent correspond bien à l'ensemble de mes données mensuels mais une erreur apparait >> Erreur D'exécution 6 : Dépassement de capacité




Pour la comparaison entre les deux fichiers, le code se lance sans problème et me récupère les références souhaité mais il y a un mais DSL.

1 - Pour une meilleur analyse ,peut on mettre devant ou après le nom de la feuille correspondant à la référence trouver ?

2 - Mes références sont uniques et ils ne peuvent être vendu 2 fois, cela rejoint ma première demande.
Peut on mettre après le regroupement un message ou autre pour m'indiquer qu'il y a des doublons .


Bien cordialement

Bonsoir,

Je ne saurai te répondre. Dis-moi seulement si avec les fichiers joints, le code fonctionne et est-il assez rapide.
Il y a bien des doublons dans l'un des fichiers après regroupement de toutes les feuilles.

Sans les données exactes, je ne peux t'aider.

Bonne soirée.

 

[cp4]

Bonjour Cp4,

J'ai pris tes fichiers et mis mes données .

Pour le fichier Vente Général ,le regroupent correspond bien à l'ensemble de mes données mensuels >>>

Pour le fichier Envoi Général ,le regroupent correspond bien à l'ensemble de mes données mensuels mais une erreur apparait >> Erreur D'exécution 6 : Dépassement de capacité




Pour la comparaison entre les deux fichiers, le code se lance sans problème et me récupère les références souhaité mais il y a un mais DSL.

1 - Pour une meilleur analyse ,peut on mettre devant ou après le nom de la feuille correspondant à la référence trouver ?

2 - Mes références sont uniques et ils ne peuvent être vendu 2 fois, cela rejoint ma première demande.
Peut on mettre après le regroupement un message ou autre pour m'indiquer qu'il y a des doublons .


Bien cordialement

Bonjour,

Ci-dessous vient de l'aide de VBE

Long, type de données

Long, type de données​

Voir aussi Exemple Particularités


Les variables de type Long (entier long) sont stockées sous la forme de nombres signés de 32 bits (4 octets) dont la valeur est comprise entre -2 147 483 648 et 2 147 483 647. Le caractère de déclaration de type Long est le signe &.

La variable i est déclarée en Long (càd i peut avoir plus de 2 milliard comme valeur) et tu as un message de dépassement de capacité. Bizarre d'autant plus qu'une feuille excel a depuis excel 2007, 1048576 lignes.
Sont donc inclues dans Long. J'avoue ne pas comprendre.

Bonne journée.

 

[scalaze]

Bonjour Cp4

J ai repris tes 2 fichiers zipper et ceux ci fonctionnent et le travail se fait rapidement,
puis j'ai ajouté plus de donnée sur les dossiers


Pour Envoi général , j'ai 4995 lignes au regroupement qui correspond bien à l'ensemble de mes données

- le regroupement fonctionne mais il y a l' Erreur D'exécution 6 : Dépassement de capacité cité plus haut.


Pour Vente Général ,j'ai 4990 lignes au regroupement qui correspond bien à l'ensemble de mes données

- Le regroupent fonctionne parfaitement et sans code erreur >>> Ok


Pour la partie contrôle,

Sur le mois d'Octobre de Envoi, la premier ligne en jaune est bien déceler sur le contrôle de Ventes
car non encore vendu. >>>>OK
Tout comme le mois de Novembre

- Peut on juste ajouter le nom de l'onglet pour une meilleur lecture.


Sur le mois d'Octobre de Ventes, la ligne en Rouge donc produit "En plus" ,
est déceler sur le control de Envoi >>>>OK.

- Peut on juste ajouter le nom de l'onglet pour une meilleur lecture.



Sur le mois d'Octobre de Ventes, la premier ligne en bleu sont des double vente pour la même référence
mais comme mes références sont unique ,il ne peut y avoir qu'un seule vente.

- Peut on mettre un message au autre pour me l'indiquer .

Tu as pratiquement ma base réelle en donnée mais pour confidentialité j 'ai du modifier les entêtes et nombre.


Lien Fichiers Zip : Dossiers


Bien cordialement