Sub Effacer1()
Dim P As Range, c As Range
Set P = [AConserver]
For Each c In P.Parent.UsedRange
If c <> "" Then If Intersect(c, P) Is Nothing Then c = ""
Next
End Sub
Sub Effacer2()
Dim P As Range, c As Range, sup As Range
Set P = [AConserver]
For Each c In P.Parent.UsedRange
If c <> "" Then If Intersect(c, P) Is Nothing _
Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
Next
If Not sup Is Nothing Then sup = ""
End Sub
Sub Effacer1()
Dim P As Range, c As Range
Set P = [AConserver]
For Each c In P.Parent.UsedRange
If Not IsEmpty(c) Then If Intersect(c, P) Is Nothing Then c = ""
Next
End Sub
Sub Effacer2()
Dim P As Range, c As Range, sup As Range
Set P = [AConserver]
For Each c In P.Parent.UsedRange
If Not IsEmpty(c) Then If Intersect(c, P) Is Nothing _
Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
Next
If Not sup Is Nothing Then sup = ""
End Sub
Je ne sais pas où c'est sur XLD, mais dans la plupart de mes codes il y en aCe bout de code ne serait-il pas à publier dans les trucs et astuces ?
... Je ne sais pas où c'est sur XLD, mais dans la plupart de mes codes il y en a...
Sub Test()
Dim T As Variant, D As Object, K As Variant
Dim Plg As Range, Sh As Worksheet, J&, Ar As Range
ActiveSheet.UsedRange
Set Sh = ActiveSheet
Set Plg = Sh.UsedRange
Set D = CreateObject("scripting.dictionary")
ReDim T(1 To Range("AConserver").Areas.Count)
For Each Ar In Intersect(Range("AConserver"), Plg).Areas
Debug.Print Ar.Address
J = J + 1
T = Sh.Range(Ar.Address).Formula
D(J) = Array(Ar.Address, T)
Next Ar
Application.ScreenUpdating = False
Sh.UsedRange.ClearContents
For Each K In D.Keys
Sh.Range(D(K)(0)).Formula = D(K)(1)
Next K
Application.ScreenUpdating = True
End Sub
Sub Test2()
Dim K As Variant, D As Object
Dim Plg As Range, Ar As Range
ActiveSheet.UsedRange
Set Plg = ActiveSheet.UsedRange
Set D = CreateObject("scripting.dictionary")
For Each Ar In Intersect(Range("AConserver"), Plg).Areas
D(Ar) = Ar.Formula
Next Ar
Application.ScreenUpdating = False
Plg.ClearContents
For Each K In D.Keys
K.Formula = D(K)
Next K
Application.ScreenUpdating = True
End Sub
... Ce bout de code ne serait-il pas à publier dans les trucs et astuces ?...
Sub tata()
Dim k%, v(), Zon As Range, Plg As Range
Set Plg = [AConserver]
With Plg.Parent
Set Plg = Intersect(.UsedRange, Plg)
For Each Zon In Plg.Areas: ReDim Preserve v(k): v(k) = Zon.Formula: k = k + 1: Next
k = 0
With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
.Cells.ClearContents
For Each Zon In Plg.Areas: Zon.Value = v(k): k = k + 1: Next
With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
End With
Set Plg = Nothing
End Sub
Ce que je souhaite faire c’est ajouter un outil dans l’inventaire Il faut donc :
Saisir le nouvel outil
Vérifier qu’il ne figure pas dans les feuilles d’inventaire (type Tab)
Vérifier qu’il subsiste de la place sur la feuille d’inventaire
Au besoin créer une nouvelle page d’inventaire en dupliquant la précédente (afin de ne pas perdre le patrimoine opérateur, puis effacer les données.
Enregistrer le nouvel Outil