[VBA] Préservation formules existantes (+identification adresse cellules)

Staple1600 · 15 Février 2018

Bonsoir le fil, le forum

Dans un classeur identique à ce que donne la macro datas, je cherche à créer une macro qui pourra réinjecter toutes formules (qui sont toutes en relation avec les valeurs en colonne A)

Voir ce petit exemple (avec deux formules)

VB:

Sub insert_formules()
'////////////////////////////////////////
datas 'macro juste pour créer données de test
'///////////////////////////////////////
'macro pour insérer formules
Dim i As Byte, adr
adr = Array(1, 5, 10)
For i = 0 To UBound(adr)
Cells(adr(i), "D").FormulaArray = "=MIN(IF(R1C1:R15C1=RC1,R1C2:R15C2))"
'avec la formule ci-dessous
'comment recopier jusqu'à la dernière cellule avant le changement de valeur en colonne A
Cells(adr(i), "F").FormulaR1C1 = "=RC[-4]/R" & adr(i) & "C4"
'ce genre de problème d'identification de la dernière cellule à mettre dans les formules 
'se reproduira pour N formules présentes dans le classeur
Next
End Sub
Private Sub datas()
Cells.Clear
[A1] = 1: [A5] = 2: [A10] = 3: [B1] = 100: [B2] = 97
 With Range("A1:A15")
    .SpecialCells(xlCellTypeBlanks).Formula = "=A1"
    .Value = .Value
End With
[B1:B2].AutoFill Destination:=Range("B1:B15")
End Sub

Je cherche le meilleur moyen d'identifier le changement de valeur en colonne A pour pouvoir en seule macro "remettre" les formules initiales (qui seront donc en dur dans le code)

Le but c'est d'éviter au maximum les suppressions accidentelles de formules (la personne utilisant le classeur ne maîtrisant pas Excel)

job75 · 20 Février 2018

Re,

Staple1600 à dit:
En effet après le tableau où restituer les formules, ils ont mis des données (sans formules pour le moment) : commentaires, notes observations etc...

Normalement il suffit de remplacer dans la la Worksheet_Change ces 2 lignes :

Code:

i = Range("A" & Rows.Count).End(xlUp).Row
Rows(IIf(i < 3, 3, i + 1) & ":" & Rows.Count).Delete 'RAZ en dessous

par celle-ci :

Code:

i = Application.Match(9 ^ 99, [A:A])

Bonne nuit.

job75 · 20 Février 2018

Bonjour JM, le forum,

J'ai revu le code et ajouté une ligne pour annuler la création d'un tableau Excel au cas où :

Code:

Private Sub Worksheet_Calculate()
Dim i As Variant
i = Application.Match(9 ^ 99, [A:A])
'---correction si le tableau est trié sur une autre colonne que la colonne A---
If Val(CStr(i)) > 4 Then If Evaluate("SUM(-(A3:A" & i - 1 & "<A4:A" & i & "))") _
    And Evaluate("SUM(-(A3:A" & i - 1 & ">A4:A" & i & "))") Or [U3] = "" _
        Then Worksheet_Change [A3]: Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A,T:V,Y:AA,AD:AF,AI:AK,AN:AQ,AV:AV]) Is Nothing Then Exit Sub 'à adapter
Dim i&, ColA As Range, n&, zoneA&(), celBaseF1, plageF1 As Range, plageF2 As Range, plageF3 As Range
Dim pas%, a(), b(), plageMoy$, deb&, fin&, f$
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
On Error Resume Next
ListObjects(1).TableStyle = "": ListObjects(1).Unlist 'si un tableau Excel a été créé
ShowAllData 'si la feuille est filtrée
i = Application.Match(9 ^ 99, [A:A])
If i < 3 Then GoTo 1
'---détermination de ColA et épuration---
Set ColA = Range("A3.A" & i)
ColA.EntireRow.Sort ColA, xlAscending, Header:=xlNo 'tri de sécurité
If ColA.Count > 1 Then ColA.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'vides
If ColA.Count > 1 Then ColA.SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete 'textes
'---mémorisation des lignes de début et de fin de zones en colonne A---
For i = 1 To ColA.Count
    If ColA(i) <> ColA(i - 1) Then
        n = n + 1
        ReDim Preserve zoneA(1 To 2, 1 To n)
        zoneA(1, n) = i
    End If
    zoneA(2, n) = i
Next i
'---initialisation des cellules de base et des plages des formules, à adapter éventuellement---
celBaseF1 = Array("H3", "J3", "L3", "N3", "P3") 'adresses (sans signe $)
Set plageF1 = Intersect(ColA.EntireRow, [T:T])
Set plageF2 = Intersect(ColA.EntireRow, [U:U])
Set plageF3 = Intersect(ColA.EntireRow, [V:V])
pas = 5 'décalage vers la droite
'---formules F1 F2 F3---
ReDim a(1 To ColA.Count, 1 To 1): b = a '2 tableaux auxiliaires pour accélérer
For i = 0 To UBound(celBaseF1)
    Set plageF1 = plageF1.Offset(, pas * Sgn(i))
    Set plageF2 = plageF2.Offset(, pas * Sgn(i))
    Set plageF3 = plageF3.Offset(, pas * Sgn(i))
    plageMoy = plageMoy & "," & plageF3(1).Address(0, 0) 'concaténation des adresses
    plageF1 = "=" & celBaseF1(i) & "*" & plageF1(1, -1).Address(0, 0) & "+2*" & plageF1(1, 0).Address(0, 0)
    For n = 1 To UBound(zoneA, 2)
        deb = zoneA(1, n): fin = zoneA(2, n)
        a(deb, 1) = "=MIN(" & plageF1(deb).Address(0, 0) & ":" & plageF1(fin).Address(0, 0) & ")"
        f = "=13*" & plageF2(deb).Address(1, 0, ReferenceStyle:=xlR1C1, RelativeTo:=plageF3(deb)) _
            & "/" & plageF1(deb).Address(0, 0, ReferenceStyle:=xlR1C1, RelativeTo:=plageF3(deb))
        For deb = deb To fin
            b(deb, 1) = f
    Next deb, n
    plageF2 = a: plageF3 = b 'restitution
Next i
'---dernières formules---
plageF3.Offset(, 1) = "=AVERAGE(" & Mid(plageMoy, 2) & ")"
plageF3.Offset(, 6) = "=SUM(" & plageF3(1, 2).Resize(, 5).Address(0, 0) & ")"
1 Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Edit : comme on le voit, si l'utilisateur entre un nombre en colonne A sous le tableau, toutes les lignes entre ce nombre et la ligne 3 seront traitées.

Bonne journée.

job75 · 20 Février 2018

Re,

La création d'un tableau Excel (avec en-têtes de colonnes en ligne 2) peut paraître stupide puisqu'il y a des cellules vides en colonne U et des formules dites "incohérentes" en colonne V.

Cela dit elle a son utilité si l'on veut que le tableau s'agrandisse automatiquement avec ses formats.

On peut alors supprimer l'organisation en tableau puis la rétablir sans problème :

Code:

Private Sub Worksheet_Calculate()
Dim i As Variant
i = Application.Match(9 ^ 99, [A:A])
'---correction si le tableau est trié sur une autre colonne que la colonne A---
If Val(CStr(i)) > 4 Then If Evaluate("SUM(-(A3:A" & i - 1 & "<A4:A" & i & "))") _
    And Evaluate("SUM(-(A3:A" & i - 1 & ">A4:A" & i & "))") Or [U3] = "" _
        Then Worksheet_Change [A3]: Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A,T:V,Y:AA,AD:AF,AI:AK,AN:AQ,AV:AV]) Is Nothing Then Exit Sub 'à adapter
Dim tablo As Range, styl$, i&, ColA As Range, n&, zoneA&(), celBaseF1
Dim plageF1 As Range, plageF2 As Range, plageF3 As Range, pas%, a(), b(), plageMoy$, deb&, fin&, f$
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
On Error Resume Next
With ListObjects(1) 'si un tableau Excel a été créé
    Set tablo = .Range: styl = .TableStyle: .TableStyle = "": .Unlist
End With
ShowAllData 'si la feuille est filtrée
i = Application.Match(9 ^ 99, [A:A])
If i < 3 Then GoTo 1
'---détermination de ColA et épuration---
Set ColA = Range("A3.A" & i)
ColA.EntireRow.Sort ColA, xlAscending, Header:=xlNo 'tri de sécurité
If ColA.Count > 1 Then ColA.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'vides
If ColA.Count > 1 Then ColA.SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete 'textes
'---mémorisation des lignes de début et de fin de zones en colonne A---
For i = 1 To ColA.Count
    If ColA(i) <> ColA(i - 1) Then
        n = n + 1
        ReDim Preserve zoneA(1 To 2, 1 To n)
        zoneA(1, n) = i
    End If
    zoneA(2, n) = i
Next i
'---initialisation des cellules de base et des plages des formules, à adapter éventuellement---
celBaseF1 = Array("H3", "J3", "L3", "N3", "P3") 'adresses (sans signe $)
Set plageF1 = Intersect(ColA.EntireRow, [T:T])
Set plageF2 = Intersect(ColA.EntireRow, [U:U])
Set plageF3 = Intersect(ColA.EntireRow, [V:V])
pas = 5 'décalage vers la droite
'---formules F1 F2 F3---
ReDim a(1 To ColA.Count, 1 To 1): b = a '2 tableaux auxiliaires pour accélérer
For i = 0 To UBound(celBaseF1)
    Set plageF1 = plageF1.Offset(, pas * Sgn(i))
    Set plageF2 = plageF2.Offset(, pas * Sgn(i))
    Set plageF3 = plageF3.Offset(, pas * Sgn(i))
    plageMoy = plageMoy & "," & plageF3(1).Address(0, 0) 'concaténation des adresses
    plageF1 = "=" & celBaseF1(i) & "*" & plageF1(1, -1).Address(0, 0) & "+2*" & plageF1(1, 0).Address(0, 0)
    For n = 1 To UBound(zoneA, 2)
        deb = zoneA(1, n): fin = zoneA(2, n)
        a(deb, 1) = "=MIN(" & plageF1(deb).Address(0, 0) & ":" & plageF1(fin).Address(0, 0) & ")"
        f = "=13*" & plageF2(deb).Address(1, 0, ReferenceStyle:=xlR1C1, RelativeTo:=plageF3(deb)) _
            & "/" & plageF1(deb).Address(0, 0, ReferenceStyle:=xlR1C1, RelativeTo:=plageF3(deb))
        For deb = deb To fin
            b(deb, 1) = f
    Next deb, n
    plageF2 = a: plageF3 = b 'restitution
Next i
'---dernières formules---
plageF3.Offset(, 1) = "=AVERAGE(" & Mid(plageMoy, 2) & ")"
plageF3.Offset(, 6) = "=SUM(" & plageF3(1, 2).Resize(, 5).Address(0, 0) & ")"
ListObjects.Add(xlSrcRange, tablo.Resize(ColA.Count + 1), , xlYes, , styl).Name = "Tableau1" 'rétablit le tableau Excel avec son style
Application.ErrorCheckingOptions.InconsistentTableFormula = False 'efface les triangles verts des formules "incohérentes"
1 Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Edit : pour peaufiner, dans ThisWorkbook :

Code:

Private Sub Workbook_Open()
Names.Add "VerifErreur", Application.ErrorCheckingOptions.InconsistentTableFormula, Visible:=False 'nom défini masqué
Application.ErrorCheckingOptions.InconsistentTableFormula = False 'efface les triangles verts des formules "incohérentes"
Saved = True 'évite l'invite à la fermeture si aucune modification
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If IsError([VerifErreur]) Then Names.Add "VerifErreur", True
Application.ErrorCheckingOptions.InconsistentTableFormula = [VerifErreur]
End Sub

A+

Staple1600 · 20 Février 2018

Bonsoir le fil, le forum

Voici une illustration synthétique du tableau(pour expliquer son fonctionnement)

La personne qui l'utilise est juste chargée de saisir les données.
Une fois cette tâche terminée, sa collègue vérifiera les calculs.

NB: Je suis sensé intervenir si problème avec les formules.
D’où le recours à la macro.
Je ne sais pas encore si l'utilisateur préfère une procédure événementielle ou cliquer sur un bouton une fois la saisie terminée pour finaliser le document.

La saisie se fait ligne par ligne.
(avec insertion manuelle de ligne si besoin dans les zones de lot)

J'ai testé la protection de feuille en ne laissant que la possibilité d'insérer des lignes et de sélectionner les cellules (dé)vérouillées.

NB: Job75: Je viens de tester ton fichier.

zebanx · 20 Février 2018

Bonsoir Staples1600 et Job75

@staples1600
Tu connais bien le discours de retour : "soit tu me fais gagner du temps (+) soit tu n'as pas confiance en mon travail (-)" (expérience testée).
Et cela, parce que sans rien connaitre à ton boulot, tu indiques qu'il y a déjà un double contrôle (celui qui saisit et celui qui vérifie).
Et que ce serait bien dommage de se priver d'un nouveau code aussi travaillé que celui de Job75 (et en plus non payant ).

Bon courage pour ton"relais" de persuasion et bravo à Job75, en particulier, pour une abnégation encore remarquée.

Staple1600 · 20 Février 2018

Re, Bonsoir zebanx

En vérité, que ce soit l'opérateur de saisie ou son "supérieur", aucun ne maîtrise Excel.

Le principal pour ce qui me concerne c'est effectivement de lire un code VBA signé job75 et d'apprendre de celui-ci.

Si il peut aider l'opérateur de saisie à alléger son "fardeau", tant mieux.

zebanx · 20 Février 2018

« Les gens les moins compétents sont systématiquement affectés aux postes où ils risquent de causer le moins de dégâts : ceux de managers. »

job75 · 20 Février 2018

Bonsoir les amis,

Je pense qu'on a compris qu'avec ma Worksheet_Change il est inutile de protéger la feuille.

On ne peut pas supprimer les formules, bien sûr si les macros sont activées...

A+

Staple1600 · 20 Février 2018

Bonsoir job75

Oui j'avais bien compris.

Je te dirai demain comment ils auront reçu la présentation de ton fichier exemple.

Précisions: Par défaut, au départ, ils mettent dans leur tableau N Lignes pour N lots
Renseigne la colonne A avec les numéros, puis efface les données saisies précédemment.
Donc en théorie, une fois la colonne A prête, la saisie ne fera plus que dans les autres colonnes.

Donc dans l'idéal, il faudrait que les formules s'inscrivent si et seulement si une ligne est complètement saisie.

Si j'ai bien compris actuellement ta macro se déclenche quand une valeur est saisie en colonne A, non ?

job75 · 20 Février 2018

Re,

Au post #48 il manquait le Resize sur cette ligne que je viens de corriger :

Code:

ListObjects.Add(xlSrcRange, tablo.Resize(ColA.Count + 1), , xlYes, , styl).Name = "Tableau1" 'rétablit le tableau Excel avec son style

Bonne nuit.

job75 · 20 Février 2018

Re,

Staple1600 à dit:
Donc dans l'idéal, il faudrait que les formules s'inscrivent si et seulement si une ligne est complètement saisie.

Non ce n'est pas l'idéal ça.

L'idéal c'est ce que j'ai fait : les formules se créent dès que des nombres sont entrés en colonne A.

Que le tableau soit un tableau Excel ou pas.

Je m'étonne que tu raisonnes ainsi vu ton niveau.

Re-bonne nuit.

job75 · 21 Février 2018

Bonjour JM, le forum,

Ce n'était pas fini, maintenant je m'occupe des lignes sous le tableau :

Code:

Private Sub Worksheet_Calculate()
Dim i As Variant
i = Application.Match(9 ^ 99, [A:A])
'---correction si le tableau est trié sur une autre colonne que la colonne A---
If Val(CStr(i)) > 4 Then If Evaluate("SUM(-(A3:A" & i - 1 & "<A4:A" & i & "))") _
    And Evaluate("SUM(-(A3:A" & i - 1 & ">A4:A" & i & "))") Or [U3] = "" _
        Then Worksheet_Change [A3]: Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A,T:V,Y:AA,AD:AF,AI:AK,AN:AQ,AV:AV]) Is Nothing Then Exit Sub 'à adapter
Dim NlignesVides&, tablo As Range, styl$, i&, ColA As Range, n&, zoneA&(), celBaseF1
Dim plageF1 As Range, plageF2 As Range, plageF3 As Range, pas%, a(), b(), plageMoy$, deb&, fin&, f$
NlignesVides = 10 'nombre de lignes vides sous le tableau, à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
On Error Resume Next
With ListObjects(1) 'si un tableau Excel a été créé
    Set tablo = .Range: styl = .TableStyle: .TableStyle = "": .Unlist
End With
ShowAllData 'si la feuille est filtrée
i = Application.Match(9 ^ 99, [A:A])
If i < 3 Then GoTo 1
'---détermination de ColA et épuration---
Set ColA = Range("A3.A" & i)
ColA.EntireRow.Sort ColA, xlAscending, Header:=xlNo 'tri de sécurité
If ColA.Count > 1 Then ColA.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'vides
If ColA.Count > 1 Then ColA.SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete 'textes
'---mémorisation des lignes de début et de fin de zones en colonne A---
For i = 1 To ColA.Count
    If ColA(i) <> ColA(i - 1) Then
        n = n + 1
        ReDim Preserve zoneA(1 To 2, 1 To n)
        zoneA(1, n) = i
    End If
    zoneA(2, n) = i
Next i
'---initialisation des cellules de base et des plages des formules, à adapter éventuellement---
celBaseF1 = Array("H3", "J3", "L3", "N3", "P3") 'adresses (sans signe $)
Set plageF1 = Intersect(ColA.EntireRow, [T:T])
Set plageF2 = Intersect(ColA.EntireRow, [U:U])
Set plageF3 = Intersect(ColA.EntireRow, [V:V])
pas = 5 'décalage vers la droite
'---formules F1 F2 F3---
ReDim a(1 To ColA.Count, 1 To 1): b = a '2 tableaux auxiliaires pour accélérer
For i = 0 To UBound(celBaseF1)
    Set plageF1 = plageF1.Offset(, pas * Sgn(i))
    Set plageF2 = plageF2.Offset(, pas * Sgn(i))
    Set plageF3 = plageF3.Offset(, pas * Sgn(i))
    plageMoy = plageMoy & "," & plageF3(1).Address(0, 0) 'concaténation des adresses
    plageF1 = "=" & celBaseF1(i) & "*" & plageF1(1, -1).Address(0, 0) & "+2*" & plageF1(1, 0).Address(0, 0)
    For n = 1 To UBound(zoneA, 2)
        deb = zoneA(1, n): fin = zoneA(2, n)
        a(deb, 1) = "=MIN(" & plageF1(deb).Address(0, 0) & ":" & plageF1(fin).Address(0, 0) & ")"
        f = "=13*" & plageF2(deb).Address(1, 0, ReferenceStyle:=xlR1C1, RelativeTo:=plageF3(deb)) _
            & "/" & plageF1(deb).Address(0, 0, ReferenceStyle:=xlR1C1, RelativeTo:=plageF3(deb))
        For deb = deb To fin
            b(deb, 1) = f
    Next deb, n
    plageF2 = a: plageF3 = b 'restitution
Next i
'---dernières formules---
plageF3.Offset(, 1) = "=AVERAGE(" & Mid(plageMoy, 2) & ")"
plageF3.Offset(, 6) = "=SUM(" & plageF3(1, 2).Resize(, 5).Address(0, 0) & ")"
'---traitement des lignes sous le tableau---
i = Application.Match(9 ^ 99, [A:A]) 'dernière ligne du tableau
1 If i < 3 Then i = 3: Rows(3) = "" 'au moins une ligne pour conserver les formats
Rows(3).AutoFill Rows("3:" & i), xlFillFormats 'copie les formats
Rows(i + 1).Resize([V:V].Find("=13*/*", , xlFormulas, xlWhole, , xlPrevious).Row - i).Delete  'RAZ
n = 0: n = Rows(i + 1 & ":" & Rows.Count).Find("*", Cells(Rows.Count, 1), xlValues, , xlByRows, xlNext).Row
If n Then n = i + NlignesVides + 1 - n 'écart
If n > 0 Then Rows(i + 1).Resize(n).Insert: Rows(Rows.Count).Copy Rows(i + 1).Resize(n)
If n < 0 Then Rows(i + 1).Resize(-n).Delete
'---rétablit le tableau Excel avec son style---
i = 0: i = ColA.Count
ListObjects.Add(xlSrcRange, tablo.Resize(i + 1), , xlYes, , styl).Name = "Tableau1"
Application.ErrorCheckingOptions.InconsistentTableFormula = False 'efface les triangles verts des formules "incohérentes"
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
With UsedRange: End With 'actualise les barres de défilement
End Sub

Fichier (2) avec tableau Excel, fichier (2 bis) sans tableau Excel.

Comme on peut le voir l'organisation en tableau Excel n'apporte vraiment pas grand-chose.

A+

Staple1600 · 21 Février 2018

Bonjour le fil, le forum

@job75
Ce que je voulais dire c'est que j'essaie pour le moment de m'adapter à la façon de faire de l'opérateur.

Au départ, un RAZ des seules données est fait.
(en ne laissant qu'un numéro en colonne A à chaque début de bloc)
ETAPE1: Préparation manuelle du nombre de lignes pour N numéros
Exemple: On lui demande d'avoir X lignes par numéro
Donc insertion manuelle (si besoin) dans chaque bloc de X lignes
Puis dans chaque bloc, CTRL+B pour recopier le numéro.

ETAPE 2: Début de la saisie des données
Exemple: On a ITEM1 à renseigner pour 1, 3 et 7
saisie sur la ligne 4 des données dans les cellules idoines
saisie sur la ligne début Bloc3 des données dans les cellules idoines
saisie sur la ligne début Bloc7 des données dans les cellules idoines

ETAPE 3: On recommence selon ce même principe
On a ITEMX à renseigner pour Nx, Ny etc...
saisie sur la ligne début Bloc Nx des données dans les cellules idoines
saisie sur la ligne début Bloc Ny des données dans les cellules idoines
etc...

Dans ce cas de figure, on ne touche plus à la colonne A.

Si les formules auront bien été mises par macro lors de la modification initiale de la colonne (ETAPE1) , pour autant l'opérateur peut oublier de saisir des données.

C'est pour cela que je parlais que l'insertion ou le calcul des cellules ne se fasse que si toutes les cellules en saisie d'une ligne ont bien été renseignées.

Ou alors j'ajoute en bout ligne un code couleur (par MFC ou macro) qui indique si la saisie est complète ou pas.
VERT: saisie OK
ROUGE: saisie erronée ou incompléte

Staple1600 · 21 Février 2018

Re

@job75
Je viens de tester Test(2)bis.xlsm
Tel quel cela oblige de saisir numéro par numéro
Et je ne peux pas insérer plusieurs lignes à la fois.

J'ai testé comme suit:
Suppression de données en ColA
puis saisie de 1 en A3 et 2 en A
Recopie incrémentée vers le bas (cellule par cellule)
Essai d'insertion de lignes (inhibée par le code)
Conclusion
Donc obligation de saisir N numéros N fois pour créer les blocs.

[APARTE]
J'étais parti sur cette idée pour "préparer le tableau"
(avant de voir ta dernière proposition)

VB:

Sub Test()
Dim Rng As Range, Plg As Range, NB_Num, i&, DerL&
NB_Num = InputBox("Nombre de blocs?", "Blocs", 5)
Application.ScreenUpdating = False
[A3:A1000] = ""
[A3].Resize(NB_Num) = "=Row()-2": [A3].Resize(NB_Num).Value = [A3].Resize(NB_Num).Value
On Error Resume Next
Set Plg = [A3].Resize(NB_Num)
For i = Plg.Rows.Count To 2 Step -1
    If Plg.Cells(i, 1).Value <> Plg.Cells(i - 1, 1).Value Then
    Plg.Cells(i, 1).Resize(9).EntireRow.Insert
    End If
Next
DerL = Cells(Rows.Count, 1).End(3).Row + 9
With Range(Cells(3, 1), Cells(DerL, 1))
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
End With
End Sub

[/APARTE]

job75 · 21 Février 2018

Re,

Staple1600 à dit:
Et je ne peux pas insérer plusieurs lignes à la fois.

Ma macro interdit l'insertion de lignes vides dans le tableau, c'est toi qui l'as voulu (post #22).

Si tu veux pouvoir entrer jusqu'à 10 nombres identiques en bas du tableau c'est facile :

- tu fais NlignesVides = 10 pour faire de la place

- tu sélectionnes A29:A38, tu entres le nombre dans la barre de formule et tu valides par Ctrl+Entrée.

A+

[VBA] Préservation formules existantes (+identification adresse cellules)

Staple1600

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

zebanx

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

zebanx

XLDnaute Accro

job75

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires