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
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
J'ai oublié de te dire merci et ne te prends pas la tête si tu y arrives tant mieux sinon
c'est déjà bien, je vais faire comme cela dans mon appli
Bonne soirée
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"
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.
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.
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
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
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).
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
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
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é.