[Résolu] Déplacement de ligne de valeurs d'une feuille vers une autre sous condition

GCogaulois

XLDnaute Nouveau
Bonjour à tous et et toutes,

J'essaye de compiler les valeurs de plusieurs feuilles de classeurs différents en une seule feuille dans un classeur. Mais voilà que les affaires se corsent et mes connaissances en langage VBA sont plus qu'insuffisantes.

Dans le fichier en pièce jointe :
la feuille 1 représente un extrait des valeurs d'une base 1 de 37000 lignes
la feuille 2 représente un extrait des valeurs d'une base 2 de 39000 lignes
J'ai donc une différence d'environ 2000 lignes.

Mon souhait numéro 1 et d'identifiées celle-ci, mon souhait n° 2 est de les extraire de la feuille 2 pour les placer en feuille 3. J'ai a disposition une colonne commune au feuille un et deux. C'est la colonne A intitulée N° de rep1.

J'ai trouver plusieurs exemples en rapport avec cette problématique mais je ne sais pas comment faire pour arriver à mon but. Si quelqu'un à une piste cela m'aiderais beaucoup, d'avance merci.

Cordialement.

GCogaulois.
 

Pièces jointes

  • Classeur1.xls
    32.5 KB · Affichages: 62
  • Classeur1.xls
    32.5 KB · Affichages: 73
  • Classeur1.xls
    32.5 KB · Affichages: 67
Dernière édition:
C

Compte Supprimé 979

Guest
Re : Déplacement de ligne de valeurs d'une feuille vers une autre sous condition

Salut Gcogaulois ;)

Comme réponse à ton MP, voici un code à essayer

J'ai essayé d'être le plus explicite possible (comme à mon habitude)
VB:
Sub ExtractionValeurUnique()
  Dim ShtS1 As Worksheet  ' Feuille source 1
  Dim ShtS2 As Worksheet  ' Feuille source 2
  Dim ShtD As Worksheet   ' Feuille de Destination
  Dim DLigS1 As Long, DLigS2 As Long, NLigD As Long, Lig As Long
  Dim sForm As String
  '
  ' Initialisation des variables
  Set ShtS1 = Sheets("Feuil1")  ' Définir la variable objet pour la feuille source 1
  Set ShtS2 = Sheets("Feuil2")  ' Définir la variable objet pour la feuille source 2
  Set ShtD = Sheets("Feuil3") ' Définir la variable objet pour la feuille destination
  '
  ' Récupérer le numéro de la dernière ligne des tableaux feuille 1 et 2
  DLigS1 = ShtS1.Range("A" & Rows.Count).End(xlUp).Row
  DLigS2 = ShtS2.Range("A" & Rows.Count).End(xlUp).Row
  '
  ' Comparer les données de la Feuille 2 par rapport à la feuille 1
  ' Avec la feuille source 2
  With ShtS2
    ' Pour chaque ligne en commençant par la fin
    For Lig = DLigS2 To 2 Step -1
      ' Formule matricielle
      ' =SOMMEPROD((Feuil1!A2:A28=7320)*(Feuil1!B2:B28="Nunu"))
      '
      ' Créer la formule matricielle pour vérifier que la ligne existe ou non
      sForm = "SUMPRODUCT((" & ShtS1.Name & "!A2:A" & DLigS1 & "=" & .Range("A" & Lig) & ")*(" _
        & ShtS1.Name & "!B2:B" & DLigS1 & "=""" & .Range("B" & Lig) & """))"
      ' Si la formule évaluée retourne 0 = pas de ligne existante en feuille 1
      If Application.Evaluate(sForm) = 0 Then
        ' Prochaine ligne vide de la feuille de destination
        NLigD = ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        ' Couper la ligne pour la coller dans la feuilel de destination
.Rows(Lig).Cut Destination:=ShtD.Rows(NLigD)
        ' Supprimer la ligne vide
.Rows(Lig).Delete Shift:=xlUp
      End If
    Next Lig
  End With
  ' Comparer les données de la Feuille 1 par rapport à la feuille 2
  ' Avec la feuille source 1
  With ShtS1
    ' Pour chaque ligne en commençant par la fin
    For Lig = DLigS1 To 2 Step -1
      ' Formule matricielle
      ' =SOMMEPROD((Feuil1!A2:A28=7320)*(Feuil1!B2:B28="Nunu"))
      '
      ' Créer la formule matricielle pour vérifier que la ligne existe ou non
      sForm = "SUMPRODUCT((" & ShtS2.Name & "!A2:A" & DLigS2 & "=" & .Range("A" & Lig) & ")*(" _
        & ShtS2.Name & "!B2:B" & DLigS2 & "=""" & .Range("B" & Lig) & """))"
      ' Si la formule évaluée retourne 0 = pas de ligne existante en feuille 2
      If Application.Evaluate(sForm) = 0 Then
        ' Prochaine ligne vide de la feuille de destination
        NLigD = ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        ' Couper la ligne pour la coller dans la feuilel de destination
.Rows(Lig).Cut Destination:=ShtD.Rows(NLigD)
        ' Supprimer la ligne vide
.Rows(Lig).Delete Shift:=xlUp
      End If
    Next Lig
  End With
  ' Effacer les variables objet pour libérer la mémoire
  Set ShtS1 = Nothing: Set ShtS2 = Nothing: Set ShtD = Nothing
End Sub

A+
 

GCogaulois

XLDnaute Nouveau
Re : Déplacement de ligne de valeurs d'une feuille vers une autre sous condition

Bruno bonsoir,

Là encore chapeau l'artiste et encore un grand merci.

A cette heure je ne comprend pas tous, mais je m'intéresserais à cela demain. Encore une fois je n'imaginais pas une envergure de programme aussi importante. Comme évoqué dans mon MP, je te sollicitais plutôt sur le reste, alors un grand merci sincèrement pour ta réponse. Tu es un chef !!! respect !

GCogaulois.
 

GCogaulois

XLDnaute Nouveau
Re : Déplacement de ligne de valeurs d'une feuille vers une autre sous condition

Bonjour le forum,

Bonjour Bruno45,

Ces lignes de programme fonctionnent très bien, je n'ai rencontré, je pense, qu'un problème de taille de fichier et/ou de nombre de ligne. J'ai alors divisé mon énorme classeur en morceau. il ne s'agit pas d'un souci de programme à mon avis mais plutôt lié à mon matériel vieillissant. Le résultat est plus que suffisant. Un grand merci à toi, cela ma permis d'élucidé beaucoup de question par rapport à l'ensemble des données assemblées, ainsi que sur la véracité de celles si.

Cordialement, merci.

GCogaulois.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof