[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)

eriiic · 15 Février 2018

Bonjour,

si tes valeurs sont toutes différentes un nb.si (en vba) te donnera la taille du bloc pour un .resize

Sinon, je ne sais pas si c'est le meilleur moyen mais une idée quand même :

Code:

=SI(A1:A15<>A2:A16;LIGNE(A1:A15);9999)

te donnera les n° de ligne des fins de bloc sous cette forme :
{9999;9999;9999;4;9999;9999;9999;9999;9;9999;9999;9999;9999;9999;15}
un petite.valeur te donnera le n° de lignes de fin de chaque bloc.
Ce qui donne en vba :

VB:

Sub test()
    Dim fb As Long, i As Long
    For i = 1 To 3
        ' ligne des fins de bloc
        fb = Evaluate("SMALL(IF(A1:A15<>A2:A16,ROW(A1:A15),9999)," & i & ")")
    Next i
End Sub

à voir si ça t'inspire.
eric

Staple1600 · 16 Février 2018

Bonsoir eriiiic

Merci d'avoir éclairé ma lanterne

VB:

Sub testB()
Dim fb As Long, x&, i&
x = Evaluate("=SUM(IFERROR(1/COUNTIF(A1:A500,A1:A500),0))")
For i = 1 To x
        ' ligne des fins de bloc
    fb = Evaluate("SMALL(IF(A1:A500<>A2:A501,ROW(A1:A500),9999)," & i & ")")
    MsgBox fb
Next i
End Sub

Mais je dois être fatigué car je peine pour déterminer le numéro de ligne du début de bloc...

job75 · 16 Février 2018

Bonjour JM, eriiiic,

Code:

'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"
Cells(adr(i), "F").Resize(Application.CountIf(Columns("A"), Cells(adr(i), "A"))).FormulaR1C1 = "=RC[-4]/R" & adr(i) & "C4"

A+

zebanx · 16 Février 2018

Bonjour Staple1600, Eriiic, Job75

Un essai par formule et VBA pour identifier première et dernière ligne.
Surement trop long.

Par ailleurs :
Le but c'est d'éviter au maximum les suppressions accidentelles de formules (la personne utilisant le classeur ne maîtrisant pas Excel)
Pourquoi ne pas protéger par verrouillage les cellules qui contiennent les formules ?

Bonne journée
zebanx

job75 · 16 Février 2018

Re, salut zebanx,

Je n'avais pas été plus loin que le code de JM mais ceci est plus cohérent :

Code:

Sub insert_formules()
datas
Dim a As Range, b As Range, c As Range
For Each a In [A1:A15].SpecialCells(xlCellTypeBlanks).Areas
    a = a(0)
    Set b = Intersect(Union(a(0), a).EntireRow, Columns("B"))
    Set c = Intersect(a(0).EntireRow, Columns("D"))
    c = "=MIN(" & b.Address(0, 0) & ")"
    Intersect(b.EntireRow, Columns("F")) = "=" & b(1).Address(0, 0) & "/" & c.Address(1, 0)
Next
End Sub

Private Sub datas()
Cells.Clear
[A1] = 1: [A5] = 2: [A10] = 3: [B1] = 100: [B2] = 97
[B1:B2].AutoFill Range("B1:B15")
End Sub

A+

zebanx · 16 Février 2018

Bonjour Job75

Un nouveau code à disséquer sans modération.
Merci.

Bonne soirée
zebanx

job75 · 16 Février 2018

Re,

Noter qu'on peut si on le désire se passer de la colonne D :

Code:

Sub insert_formules()
datas
Dim a As Range, b As Range
For Each a In [A1:A15].SpecialCells(xlCellTypeBlanks).Areas
    a = a(0)
    Set b = Intersect(Union(a(0), a).EntireRow, Columns("B"))
    Intersect(b.EntireRow, Columns("F")) = "=" & b(1).Address(0, 0) & "/MIN(" & b.Address(1, 0) & ")"
Next
End Sub

Private Sub datas()
Cells.Clear
[A1] = 1: [A5] = 2: [A10] = 3: [B1] = 100: [B2] = 97
[B1:B2].AutoFill Range("B1:B15")
End Sub

Nota : comme précédemment il est inutile d'utiliser .Formula, VBA sait qu'on est en notation A1...

A+

eriiic · 16 Février 2018

Bonjour,

Mais je dois être fatigué car je peine pour déterminer le numéro de ligne du début de bloc...

TREEES fatigué même
La 1ère d'un bloc et celle qui suit la dernière du bloc précédent ;-)

Sinon l'idée de ne pas remplir A tout de suite et de se servir des cellules vides pour déterminer la plage est mieux je pense.
Mais sont-elles vraiment vides en réalité ou bien c'est juste pour la construction de l'exemple (?)
eric

job75 · 16 Février 2018

Re,

S'il s'agit de toujours récupérer la dernière cellule de chaque paquet en colonne B MIN est inutile :

Code:

Sub insert_formules()
datas
Dim a As Range, b As Range
For Each a In [A1:A15].SpecialCells(xlCellTypeBlanks).Areas
    a = a(0)
    Set b = Intersect(Union(a(0), a).EntireRow, Columns("B"))
    Intersect(b.EntireRow, Columns("F")) = "=" & b(1).Address(0, 0) & "/" & b(b.Count).Address(1, 0)
Next
End Sub

Private Sub datas()
Cells.Clear
[A1] = 1: [A5] = 2: [A10] = 3: [B1] = 100: [B2] = 97
[B1:B2].AutoFill Range("B1:B15")
End Sub

A+

job75 · 16 Février 2018

Re,

eriiiic à dit:
Mais sont-elles vraiment vides en réalité ou bien c'est juste pour la construction de l'exemple (?)

Si la colonne A n'est pas vidée au départ elle est tout à fait inutile, on peut s'appuyer sur la colonne B :

Code:

Dim a As Range 'mémorise la variable

Sub insert_formules()
datas
For Each a In a.Areas
    Intersect(Union(a(0), a).EntireRow, Columns("F")) = "=" & a(0).Address(0, 0) & "/" & a(a.Count).Address(1, 0)
Next
End Sub

Private Sub datas()
[B1] = 100: [B2] = 97
[B1:B2].AutoFill [B1:B15]
Set a = Union([B2:B4], [B6:B9], [B11:B15]) 'plages disjointes
End Sub

A+

Staple1600 · 16 Février 2018

Bonsoir le fil, le forum

Je rentre juste du boulot (après un détour dans un temple de la consommation)

Merci déjà pour vos réponses.

Je reviens avec plus de détails et les formules du fichier orginal

NB: Le fichier n'a pas été construit par moi.

Staple1600 · 16 Février 2018

Re

Voici les formules utilisées dans le classeur
(je n'ai mis que les formules de la ligne 3)

VB:

Sub creer_test()
valeurs
formules
End Sub

Private Sub valeurs()
Cells.Clear
[A3:A6] = 1: [A7:A11] = 2: [A12:A18] = 3: [A19:A28]=4
'ne pas tenir compte de ces formules, c'est juste pour simuler une saisie de valeurs
Range("H3:H28").FormulaR1C1 = "=RAND()*ROW()/10"
Range("J3:J28").FormulaR1C1 = "=RAND()*ROW()/COLUMN()"
Range("R3:R28").FormulaR1C1 = "=ROW()*PI()/3"
Range("S3:S28").FormulaR1C1 = "=ROW()/RAND()^2/17"
Range("W3:W28").FormulaR1C1 = "=ROW()*PI()/COLUMN()"
Range("X3:X28").FormulaR1C1 = "=ROW()/RAND()^2/19"
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
End Sub
Private Sub formules()
'ci-dessous les formules originales (sauf pour le MIN)
'les adresses des cellules des formules sont les bonnes
'le tableau commence en ligne 3
[T3].Formula = "=(H3*R3)+(S3*2)"
[U3].FormulaArray = "=MIN(IF($A$3:$A$282=$A3,$T$3:$T$282))"
[V3].Formula = "=13*U$3/T3"
[Y3].Formula = "=(J3*W3)+(X3*2)"
[Z3].Formula = "=MIN(IF($A$3:$A$282=$A3,$Y$3:$Y$282))"
[AA3].Formula = "=13*Z$3/Y3"
[AD3].Formula = "=(L3*AB3)+(AC3*2)"
[AE3].FormulaArray = "=MIN(IF($A$3:$A$282=$A3,$AD$3:$AD$282))"
[AF3].Formula = "=13*AE$3/AD3"
[AI3].Formula = "=(N3*AG3)+(AH3*2)"
[AJ3].FormulaArray = "=MIN(IF($A$3:$A$282=$A3,$AI$3:$AI$282))"
[AK3].Formula = "=13*AJ$3/AI3"
[AN3].Formula = "=(P3*AL3)+(AM3*2)"
[AO3].FormulaArray = "=MIN(IF($A$3:$A$282=$A3,$AN$3:$AN$282))"
[AP3].Formula = "=13*AO$3/AN3"
[AQ3].Formula = "=AVERAGE(V3,AA3,AF3,AK3,AP3)"
[AV3].Formula = "=SUM(AQ3:AU3)"
End Sub

Staple1600 · 16 Février 2018

Re

Précisions:
La colonne A n'est pas vidée et est essentielle
(elle correspond à des N° de lot)
Chaque lot implique des données différentes à saisir
D'où la recopie à chaque changement de lot
L'utilisateur peut selon son besoin ajouter ou supprimer des lignes
(dans ce cas, il indiquera le numéro en colonne A)

eriiic · 16 Février 2018

La colonne A n'est pas vidée et est essentielle
(elle correspond à des N° de lot)

Il n'y a donc pas de doublons.
nb.si() te donne la taille de la plage non ?
eric

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

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

zebanx

XLDnaute Accro

Pièces jointes

job75

XLDnaute Barbatruc

zebanx

XLDnaute Accro

job75

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Discussions similaires