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

Staple1600

XLDnaute Barbatruc
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)
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour JM, le forum,

Concernant ton post #71 inutile d'utiliser PLAFOND, la fonction ENT (INT) suffit :
Code:
Sub test_A()
Dim Z$, X&, Y&, p As Range: [A3:A1600] = Empty: Application.ScreenUpdating = False
Z = InputBox("Nombre d'items Nombre de ligne?", "Préparation du tableau", "10 5"): X = Split(Z)(0): Y = Split(Z)(1)
Set p = [A3].Resize(X * Y): p = "=1+INT((ROW()-3)/" & Y & ")": p.Value = p.Value
End Sub

Sub test_B()
Dim XY, X&, Y&, sPrompt$, t, i&: [A3:A1600] = ""
sPrompt = _
"Nombre d'items/Nombre de lignes?" & Chr(13) & Chr(13) & "(saisie valide : X/Y)"
XY = InputBox(sPrompt, "Préparation du tableau", "10/5")
If UBound(Split(XY, "/")) < 1 Then Exit Sub
X = Split(XY, "/")(0): Y = Split(XY, "/")(1): ReDim t(1 To X * Y, 1 To 1)
For i = 1 To UBound(t): t(i, 1) = 1 + Int((i - 1) / Y): Next
[A3].Resize(UBound(t)) = t
End Sub
PS : je ne vois pas trop l'intérêt d'initialiser la plage ainsi, il vaut mieux utiliser ma macro CreerZone.

Mais si tu veux faire quelque chose de bien fais en sorte que la hauteur Y des zones soit aléatoire...

Bonne journée.
 

job75

XLDnaute Barbatruc
Re,

Fichier (2 bis) avec ce code pour une initialisation aléatoire :
Code:
Dim NlignesVides& 'mémorise la variable

Sub InitialisationJustePourTester()
Dim Nlig, Hmax, i&, j&, n&, PC As Range
On Error Resume Next
Nlig = Int(Val(InputBox("Nombre de lignes du tableau, limite 20 000 :", "Initialisation", 500)))
If Nlig < 1 Or Nlig > 20000 Then Exit Sub
Hmax = Int(Val(InputBox("Maximum de lignes par zone, limite 1000 :", "Initialisation", 10)))
If Hmax < 1 Or Hmax > 1000 Then Exit Sub
ReDim a(1 To Nlig, 1 To 1)
Randomize
For i = 1 To Nlig
    If i > j Then
        n = n + 1
        j = j + Int(1 + Rnd * Hmax)
    End If
    a(i, 1) = n
Next
Set PC = [PremiereCellule]
Application.ScreenUpdating = False
CheckBox1 = True 'Manuel
PC(3).Resize(Rows.Count - PC.Row - 1).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete 'RAZ
NlignesVides = Nlig: CheckBox1 = False 'décale ce qui est sous le tableau
NlignesVides = 0: PC(2).Resize(Nlig) = a
End Sub
A+
 

Pièces jointes

  • Zones et formules(2 bis).xlsm
    54.3 KB · Affichages: 33

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

@job75
Par manque de temps, je me reconnecte qu’aujourd’hui.
Concernant ton post #71 inutile d'utiliser PLAFOND, la fonction ENT (INT) suffit :
J'en avais l'intuition.
Ce qui confirme que si j'ai bien la fibre optique, la fibre ludique, je n'ai point la fibre mathématique (hélas)

Merci en tout cas pour toutes tes interventions dans ce fil.

@eriiiic
Tout est simple quand tu es le propre créateur/utilisateur d'un classeur.
Là, la difficulté c'est d'abord que je pars d'un classeur que je n'ai pas créer et qu'on m'impose tel quel
J'ai tenté de proposer une autre approche. En vain.
Ensuite la personne qui saisit doit suivre les directives d'une autre (directives qui ne sont pas forcément des plus judicieuses "Excelment" parlant)


Il reste un dernier point (soumis vendredi dernier par mes collègues)
Si je n'arrive pas à le résoudre avec tout le VBA présent dans ce fil, je reviendrai vous poser la question.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum


Pour illustrer le dernier desiderata de mes collègues
Une fois la saisie terminée, un tri est effectué.
(NB: On me certifie qu'avant, le tri se faisait manuellement dans Excel sans le déplacement illustré ci-dessous.
Ce à quoi je réponds que ce n'est pas possible
Et on me rétorque :" Bah, si c'est ce qu'on a fait l'année dernière,et ça marchait bien")
01Tri.jpg

J'ai beau me creuser les méninges, je suis persuadé d'avoir raison
Me trompe-je?

Je vais relire posément le code VBA de job75 pour
1) voir si cet écueil* n'est pas déjà traité dans le fil
2) essayer d'adapter le code existant pour pallier cet écueil

*: L’écueil étant donc de replacer les MIN en début de blocs après le tri (qui sera fait manuellement)

Bon dimanche à tous.
 

Staple1600

XLDnaute Barbatruc
Bonjour job75

Je parlais du fait qu'un tri manuel déplace forcément les cellules.
Ce à quoi mes collègues prétendaient le contraire.

Et j'ai précisé
Je vais relire posément le code VBA de job75 pour
1) voir si cet écueil* n'est pas déjà traité dans le fil

EDITION: Merci job75 pour toutes ces solutions, en toute logique le tour de la question a été fait.

Je vous tiendrai au courant de l'utilisation du classeur original amendé avec le code de job par l'utilisateur final.
 
Dernière édition:

Discussions similaires

Réponses
7
Affichages
494
Réponses
14
Affichages
861
Réponses
16
Affichages
1 K
Réponses
3
Affichages
510

Statistiques des forums

Discussions
314 628
Messages
2 111 336
Membres
111 104
dernier inscrit
JEMADA