Rechercher les valeurs non présentes et les insérer selon ordre croissant

[WIsh_]

Bonjour,

Ci-joint un fichier composé de 3 feuilles.
Je cherche une macro qui permettrai de vérifier si les valeurs présentes dans les feuilles 2 et 3 se trouvent dans la feuille 1 colonne A.
Si oui, ne rien faire.
Si non, insérer ces valeurs dans la colonnes A de la feuille 1 suivant l'ordre croissant.

=>Dans le fichier ci-joint, la valeur surlignée en jaune de la feuille 2 ne se trouve pas dans la feuille 1. Elle devrait être insérée après la ligne 25.
=>La valeur surlignée en jaune de la feuille 3 ne se trouve pas non plus dans la feuille 1. Elle devrait être insérée après la ligne 201 de la feuille 1.

Merci d'avance pour votre aide,
Bien cordialement,

Wish

 

[CHALET53]

Bonjour
Un essai
a+

 

[WIsh_]

Bonjour @CHALET53,

Merci pour l'essai.

Mon tableau original comprend des données et formules dans les colonnes B à AB. Il comprend aussi une ligne totale en fin des valeurs de la feuille 1.

Ta proposition ajoute la valeur après la dernière ligne puis trie les valeurs pour quelle soit bien positionnées.

Il faudrait qu'une ligne soit insérée après la valeur de la feuille 1 qui correspond à celle qui arrive juste avant celle trouvée dans la feuille 2 ou la feuille 3 qui ne se trouvait pas dans la feuille 1.

La macro devrait tout décaler d'une ligne et insérer la valeur trouvée directement à la bonne place.

Bàt,
Wish

 

[CHALET53]

Peut-être comme ça
a+

 

[WIsh_]

Bonjour @CHALET53,

Merci.
Mon problème est que les nouvelles lignes ne disposent pas des formules présentes dans le tableau. Il me faut tirer les formules présentes dans les colonnes B à AB dans les nouvelles lignes insérées.

Je n'ai pas réussi en essayant de modifier ton code...

Voir les lignes surlignées en jaune dans le fichier ci-joint.

Est-ce aussi possible de déclencher la macro lors d'un passage d'un onglet à l'autre ou lors de l'ouverture ou de l'enregistrement du fichier ?

Merci d'avance,
Bien à toi,

Wish

 

[CHALET53]

Un essai
J'ai copié la formule générale en AA1:AD1
Lors de l'insertion d'une ligne, je copie ces formules dans la ligne insérée
Donc, ne jamais détruire la ligne 1 (ou alors recopier les formules en AA1:AD1)

 

[Dranreb]

Bonjour.
Comme d'habitude je fais ce genre d'interclassement avec des modules de service.
Effectué à l'activation de Feuil1, en reproduisant les formules de la 1ère ligne.

 

[CHALET53]

Bonjour Dranreb
Travail d 'expert : je m'incline (trop complexe pour moi)
... mais chapeau

a+

 

[WIsh_]

Re @CHALET53, bonjour @Dranreb,

Une fois de plus mon fichier test était mal formaté, et je m'en excuse.

La 1ère ligne avec la liste des valeurs en colonne A et des formules dans les colonnes B à Z.
La dernière ligne du tableau en feuille 1 est une ligne "total".

Voir fichier ci-joint.

J'ai essayé la macro dans ce fichier et évidemment, ça ne fonctionne pas.

Le fichier de CHalet fonctionne mais je ne peux pas ajouter des formules en AA1:AD1.
La solution de Dranreb fonctionne mais je n'arrive pas à l'adapter à mon fichier du coup..

Merci d'avance pour votre aide,
Wish

 

[Dranreb]

Adapté comme ça ça devrait passer, non ? :

Private Sub Worksheet_Activate()
   Dim CMax As Long, TFml() As String, Données As Collection, SG As SsGr, L As Long, C As Long, TRés(), TLig()
   CMax = Feuil1.UsedRange.Columns.Count
   ReDim TFml(2 To CMax)
   For C = 2 To CMax
      With Feuil1.Cells(1, C)
         If .HasFormula Then TFml(C) = .FormulaR1C1
         End With: Next C
   Set Données = Gigogne(TableUnique(Feuil1.[A8], Feuil2.[A1], Feuil3.[A1]), 1)
   ReDim TRés(1 To Données.Count, 1 To CMax)
   For Each SG In Données
      L = L + 1: TLig = SG.DonnéesDébut
      For C = 1 To UBound(TLig): TRés(L, C) = TLig(C): Next C, SG
   With Feuil1.[A8].Resize(L, CMax)
      .Value = TRés
      For C = 2 To CMax
         If TFml(C) <> "" Then .Columns(C).FormulaR1C1 = TFml(C)
         Next C
      End With
   End Sub

Ah non, je viens de voir qu'il y avait une ligne total à la fin.
Dans ce cas ne pourrait-on pas mettre cette plage sous forme de tableau, ce serait plus simple ?

 

[WIsh_]

Re Dranreb,

Hélas non.
Mais ne peut-on pas dire "jusque la dernière ligne -1" ?

Bien à toi,
Wish

 

[Dranreb]

Alors essayer comme ça :

Private Sub Worksheet_Activate()
   Dim CMax As Long, TFml() As String, RngF1 As Range, Données As Collection, _
      SG As SsGr, L As Long, C As Long, TRés(), TLig()
   CMax = Feuil1.UsedRange.Columns.Count
   ReDim TFml(2 To CMax)
   For C = 2 To CMax
      With Feuil1.Cells(8, C)
         If .HasFormula Then TFml(C) = .FormulaR1C1
         End With: Next C
   Set RngF1 = PlgUti(Feuil1.[A8])
   Set RngF1 = RngF1.Resize(RngF1.Rows.Count - 1)
   Set Données = Gigogne(TableUnique(RngF1, Feuil2.[A1], Feuil3.[A1]), 1)
   ReDim TRés(1 To Données.Count, 1 To CMax)
   For Each SG In Données
      L = L + 1: TLig = SG.DonnéesDébut
      For C = 1 To UBound(TLig): TRés(L, C) = TLig(C): Next C, SG
   If L > RngF1.Rows.Count Then
      RngF1.Rows(2).Resize(L - RngF1.Rows.Count).Insert xlShiftDown, xlFormatFromLeftOrAbove
      End If
   With RngF1.Resize(L, CMax)
      .Value = TRés
      For C = 2 To CMax
         If TFml(C) <> "" Then .Columns(C).FormulaR1C1 = TFml(C)
         Next C
      End With
   End Sub

 

[WIsh_]

Re @Dranreb,

J'ai mis les macros dans le fichier ci-dessous mais j'obtiens une erreur lors de l'exécution de la macro.
"Type défini par l'utilisateur non défini" dans la fonction "DicInvent" (?)

Merci pour ta patience et merci pour l'aide,
Wish

 

[Dranreb]

Ouais je sais, pas grave. Activez la référence Microsoft Scripting Runtime.
Chez moi elle est systématiquement cochée dans tous les classeurs.

 

[WIsh_]

Re @Dranreb,

Ca marche nickel merci beaucoup.

Bon dimanche,
Wish