XL 2016 solidarisation de lignes en VBA

G

GOLE

XLDnaute Nouveau
Bonjour le forum,
Vous trouverez en PJ un fichier "test" où j'aimerai solidariser des lignes grâce au VBA
Mes connaissances en vba sont très limitées et se résument à adapter des codes à mes applications
Merci par avance
 

Pièces jointes

  • TEST.xlsm
    32 KB · Affichages: 34
Trier par date Trier par votes
_Thierry

_Thierry

XLDnaute Barbatruc
Repose en paix
Re Bonjour @GOLE, le Forum

Essaie cette version, je tente de recopier les formules lors de l'insertion, mais c'est un peu bricolage du dimanche...

J'ai commenté
@+Thierry
 

Pièces jointes

  • XLD_GOLE_TEST_Insert_Reference_v02.xlsm
    39.9 KB · Affichages: 3
Vote positif 0 Vote négatif
G

GOLE

XLDnaute Nouveau
Le bricolage marche mais comme j'ai beaucoup de cellules par ligne contenant des formules...
est ce qu'on ne pourrait pas
Si "plage" c'est mon tableau (A1:G23) dans feuille table
il faudrait inserer chaque nouvelle ligne sur la deuxieme ligne du tableau (en A2)
puis recopier la ligne du dessous sauf les constantes
Set Plage = ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, 3)
If Not Plage Is Nothing Then Plage.ClearContents
 
Vote positif 0 Vote négatif
_Thierry

_Thierry

XLDnaute Barbatruc
Repose en paix
Re GOLE

Je n'en sais rien du tout ! Jamais utilisé xlCellTypeConstants , mais le mélange VBA plus Formules plus Constantes "Bon état" etc à ne pas prendre en compte complique le truc un max et ca va faire boum si on a pas tous les cas de figures... En plus tu dis ""j'ai beaucoup de cellules par ligne contenant des formules""

Non là je vais méditer sur des trucs plus "amusants" ;)

Bon courage
@+Thierry
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour GOLE, sylvanu, _Thierry,

Voyez le fichier joint et cette macro dans le code de la 2ème feuille :
VB: 
Private Sub Worksheet_Activate()
Dim ncol%, tablo, resu(), d As Object, i&, x$, n&, j%, a
ncol = 3 'nombre de colonnes, à adapter
'---liste sans doublon---
tablo = Sheets("Saisie").[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    d(CStr(tablo(i, 1))) = ""
Next i
'---tableau des résultats---
If d.Count Then
    ReDim resu(1 To Rows.Count, 1 To ncol)
    tablo = [A1].CurrentRegion.Resize(, 3).Formula 'pour conserver les formules
    For i = 1 To UBound(tablo)
        x = tablo(i, 1)
        If Left(x, 1) = "=" Then x = CStr(Evaluate(x)) 's'il y a une formule en colonne A elle est conservée
        If d.exists(x) Then
            n = n + 1
            For j = 1 To ncol
                resu(n, j) = tablo(i, j) 'copie la ligne
            Next j
            d.Remove x 'l'élément traité est retiré de la liste
        End If
    Next i
End If
'---ajout des éléments de la liste non traités---
If d.Count Then
    a = d.keys
    For i = 0 To UBound(a)
        n = n + 1
        resu(n, 1) = a(i)
    Next i
End If
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n, ncol) = resu
        .Resize(n, ncol).Sort .Cells, xlAscending, Header:=xlNo 'tri sur la 1ère colonne
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
La macro se déclenche quand on active la feuille.

Avec cette solution la colonne C de la 1ère feuille est inutile.

Les formules de la 2ème feuille sont conservées.

A+
 

Pièces jointes

  • TEST(1).xlsm
    36.8 KB · Affichages: 4
Vote positif 0 Vote négatif
G

GOLE

XLDnaute Nouveau
job75 à dit:
Bonjour GOLE, sylvanu, _Thierry,

Voyez le fichier joint et cette macro dans le code de la 2ème feuille :
VB: 
Private Sub Worksheet_Activate()
Dim ncol%, tablo, resu(), d As Object, i&, x$, n&, j%, a
ncol = 3 'nombre de colonnes, à adapter
'---liste sans doublon---
tablo = Sheets("Saisie").[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    d(CStr(tablo(i, 1))) = ""
Next i
'---tableau des résultats---
If d.Count Then
    ReDim resu(1 To Rows.Count, 1 To ncol)
    tablo = [A1].CurrentRegion.Resize(, 3).Formula 'pour conserver les formules
    For i = 1 To UBound(tablo)
        x = tablo(i, 1)
        If Left(x, 1) = "=" Then x = CStr(Evaluate(x)) 's'il y a une formule en colonne A elle est conservée
        If d.exists(x) Then
            n = n + 1
            For j = 1 To ncol
                resu(n, j) = tablo(i, j) 'copie la ligne
            Next j
            d.Remove x 'l'élément traité est retiré de la liste
        End If
    Next i
End If
'---ajout des éléments de la liste non traités---
If d.Count Then
    a = d.keys
    For i = 0 To UBound(a)
        n = n + 1
        resu(n, 1) = a(i)
    Next i
End If
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n, ncol) = resu
        .Resize(n, ncol).Sort .Cells, xlAscending, Header:=xlNo 'tri sur la 1ère colonne
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
La macro se déclenche quand on active la feuille.

Avec cette solution la colonne C de la 1ère feuille est inutile.

Les formules de la 2ème feuille sont conservées.

A+
Cliquez pour agrandir...
job75 à dit:
Bonjour GOLE, sylvanu, _Thierry,

Voyez le fichier joint et cette macro dans le code de la 2ème feuille :
VB: 
Private Sub Worksheet_Activate()
Dim ncol%, tablo, resu(), d As Object, i&, x$, n&, j%, a
ncol = 3 'nombre de colonnes, à adapter
'---liste sans doublon---
tablo = Sheets("Saisie").[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    d(CStr(tablo(i, 1))) = ""
Next i
'---tableau des résultats---
If d.Count Then
    ReDim resu(1 To Rows.Count, 1 To ncol)
    tablo = [A1].CurrentRegion.Resize(, 3).Formula 'pour conserver les formules
    For i = 1 To UBound(tablo)
        x = tablo(i, 1)
        If Left(x, 1) = "=" Then x = CStr(Evaluate(x)) 's'il y a une formule en colonne A elle est conservée
        If d.exists(x) Then
            n = n + 1
            For j = 1 To ncol
                resu(n, j) = tablo(i, j) 'copie la ligne
            Next j
            d.Remove x 'l'élément traité est retiré de la liste
        End If
    Next i
End If
'---ajout des éléments de la liste non traités---
If d.Count Then
    a = d.keys
    For i = 0 To UBound(a)
        n = n + 1
        resu(n, 1) = a(i)
    Next i
End If
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n, ncol) = resu
        .Resize(n, ncol).Sort .Cells, xlAscending, Header:=xlNo 'tri sur la 1ère colonne
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
La macro se déclenche quand on active la feuille.

Avec cette solution la colonne C de la 1ère feuille est inutile.

Les formules de la 2ème feuille sont conservées.

A+
Bonjour Job75,
Merci d'abord pour ce code de ouf!
Par contre ça ne correspond pas à ce que je veux
Effectivement la colonne C de la feuille saisie est inutile
Dans la feuille table j'ai un tableau à l'origine vierge avec des formules sur certaines colonnes
La dernière réponse de thierry marchait trés bien dans le test mais mon application réelle comporte + de 100 colonnnes et 500 lignes dont 60 colonnes avec des formules
il faudrait juste modifier dans son code la partie ou il duplique les formules de la ligne d'aprés pour les mettre sur la nouvelle ligne référencée j'ai mis dans le commentaire de son codela partie qu'il faudrait modifier commençant par 'Merci job 75...
Vu le niveau que vous avez ça devrait pas être trop dur :)
Merci pour votre réponse
Cliquez pour agrandir...
 

Pièces jointes

  • XLD_GOLE_TEST_Insert_Reference_v02.xlsm
    37 KB · Affichages: 4
Vote positif 0 Vote négatif
G

GOLE

XLDnaute Nouveau
Bonjour Job75,
Merci d'abord pour ce code de ouf!
Par contre ça ne correspond pas à ce que je veux
Effectivement la colonne C de la feuille saisie est inutile
Dans la feuille table j'ai un tableau à l'origine vierge avec des formules sur certaines colonnes et au fur à mesure que je rentre les references dans saisie je complète mon tableau manuellement sur les partie où il n'y a pas de formule.
La dernière réponse de Thierry marchait très bien dans le test mais mon application réelle comporte + de 100 colonnes et 500 lignes dont 60 colonnes avec des formules
il faudrait juste modifier dans son code la partie ou il duplique les formules de la ligne d’après pour les mettre sur la nouvelle ligne référencée (sans les constantes) j'ai mis dans le commentaire de son code la partie qu'il faudrait modifier commençant par 'Merci job 75...
Vu le niveau que vous avez ça ne devrait pas être trop dur :)
Les avertissements pour lignes supprimées ou autres ne me sont pas utiles
En P.J la dernière version du code
Merci pour votre réponse
 

Pièces jointes

  • XLD_GOLE_TEST_Insert_Reference_v02.xlsm
    37 KB · Affichages: 2
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Si j'ai proposé un code c'est pour qu'au moins vous le testiez et essayiez de le comprendre !

Il est suffisamment commenté, vous devriez y arriver sans trop de difficulté.

Avec ce nouveau fichier il suffisait d'adapter ncol = 7, le voici en retour.
 

Pièces jointes

  • XLD_GOLE_TEST_Insert_Reference(1).xlsm
    35.5 KB · Affichages: 3
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Puisque les formules sont "tirées" sur l'entièreté de chaque colonne D E G on utilisera cette macro :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
With [A1].CurrentRegion.Offset(1)
    If .Rows.Count = 1 Then Exit Sub
    Application.EnableEvents = False 'désactive les évènements
    .Columns(4).Resize(.Rows.Count - 1) = "=B2*100"
    .Columns(5).Resize(.Rows.Count - 1) = "=SQRT(D2)"
    .Columns(7).Resize(.Rows.Count - 1) = "=E2/2"
    Application.EnableEvents = True 'réactive les évènements
End With
Dans la Worksheet_Activate il n'est alors plus nécessaire de s'occuper des formules, voyez ce fichier (2).
 

Pièces jointes

  • XLD_GOLE_TEST_Insert_Reference(2).xlsm
    36.7 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Vous dites qu'il y a 60 colonnes avec des formules.

Dans la macro Worksheet_Change il faudrait alors écrire 60 lignes avec les formules correspondantes.

On peut l'éviter comme dans ce fichier (3) en utilisant une feuille "Formules" et la macro :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim col%
With [A1].CurrentRegion.Offset(1)
    If .Rows.Count = 1 Then Exit Sub
    Application.EnableEvents = False 'désactive les évènements
    For col = 1 To .Columns.Count
        If Sheets("Formules").Cells(2, col).HasFormula Then _
            .Columns(col).Resize(.Rows.Count - 1) = Sheets("Formules").Cells(2, col).Formula
    Next
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub
 

Pièces jointes

  • XLD_GOLE_TEST_Insert_Reference(3).xlsm
    38.3 KB · Affichages: 5
Vote positif 0 Vote négatif
G

GOLE

XLDnaute Nouveau
Merci Job 75, super travail !
"L'essayer c'est l'adopter" je me suis inquiété car il y a beaucoup de termes du code que je ne comprends pas notamment cette déclaration :
Dim ncol%, tablo, resu(), d As Object, i&, x$, n&, j%, a
Après avoir testé l'exemple :
- si une cellule est vide dans saisie, la liste sans doublons dans table ne prend pas en compte toutes les valeurs, serait-il possible d'y remédier
- Très important lorsque je modifie dans saisie une référence existante (100 remplacé par 103) il faudrait que les valeurs dans tables ne soient pas remises à zéro (103 devrait correspondre à 10 tables)
-au lieu de créer une feuille Formules pourrait-on faire référence à la deuxième ligne du tableau dans table (sans grande importance néanmoins, juste pour savoir)
A part ces 3 remarques tout est OK
J'espère que tu pourras trouver, J'ai hâte de tester sur mon appli
Encore merci pour ton investissement
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour GOLE, le forum,

Pour la 1ère remarque voyez ce fichier (4) et le code modifié :
VB: 
'---liste sans doublon---
With Sheets("Saisie")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)(2)) 'matrice, plus rapide, au moins 2 éléments
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If x <> "" Then d(x) = ""
Next i
Cela dit dans une base de données qui tient la route il n'y a pas de lignes vides !

La 2ème remarque est totalement illogique et il est impossible de la mettre en œuvre.

Pour la 3ème remarque la 2ème ligne du tableau des résultats est effacée si le tableau de la 1ère feuille est vide, il vaut mieux stocker les formules dans un lieu sûr, soit dans le code VBA soit dans la feuille "Formules" (qu'on peut masquer).

Et je déconseille ici de transformer le tableau des résultats en tableau structuré.

Pour les déclarations des variables :

% => As Integer

& => As Long

$ => As String

resu() pour déclarer resu comme tableau (Array).

Bonne journée.
 

Pièces jointes

  • XLD_GOLE_TEST_Insert_Reference(4).xlsm
    38.8 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

cathodique
  • Résolu(e)
XL 2010 Format Textbox dynamique
2 3
Réponses
36
Affichages
2 K
Eric C
Eric C
J
  • Question
Combobox - Scroller avec la souris
Réponses
6
Affichages
127
patricktoulon
patricktoulon
A
  • Question
XL 2019 Filtre avancé en VBA
Réponses
12
Affichages
281
Amilo
A
F
  • Résolu(e)
Microsoft 365 Supprimer des lignes en fonction de la date et de l'heure
Réponses
8
Affichages
261
AtTheOne
AtTheOne
chris6999
  • Question
Microsoft 365 MACRO VBA - Extraire des listes à partir d'une boucle
Réponses
5
Affichages
186
chris6999
chris6999
Cédric06400
  • Question
Microsoft 365 Pagination multi feuilles
2
Réponses
15
Affichages
658
Eric KERGRESSE
E
C
  • Résolu(e)
XL 2019 Problème d'ajout automatique de lignes à un tableau : la première s'ajoute au tableau mais pas les suivantes !
Réponses
9
Affichages
179
Clemee61
C
Mathmath06
  • Question
XL 2016 Calcul écart de combinaison de 4 numéros Keno
2
Réponses
15
Affichages
637
Mathmath06
Mathmath06
A
  • Résolu(e)
Microsoft 365 Vider des listes déroulantes en cascade
Réponses
6
Affichages
295
Franc58
F
F
  • Question
XL 2013 Tri d'une listbox sur 2 combobox en cascade
2
Réponses
25
Affichages
492
franxy
F

Membres actuellement en ligne

5 membres et 167 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 023
Messages
2 084 716
Membres
102 636
dernier inscrit
TOTO33000