XL 2016 VBA: Validation de cellules non vide

Erakmur

XLDnaute Occasionnel
Bonjour,

Cette formule permet de valider toute les cellules de AJ9 à AJ2000.

Application.Calculation = xlManual
Application.ScreenUpdating = False
For Each c In [Aj9:Aj2000]
c = c.Formula
Next
Application.Calculation = xlAutomatic

Je voudrai qu'elle ne valide que les cellules non vides de AJ9 à AJ2000 et pas toutes les cellules.

Cordialement
 

Erakmur

XLDnaute Occasionnel
A ok, je ne savais pas que c'était la même réponse ! Je pensais que le sujet était différent ! Je fais le test.
 

Erakmur

XLDnaute Occasionnel
J'ai remplacé par ta formule mais cela ne fonctionne pas. Erreur d'execution 404.

Application.Calculation = xlManual
Application.ScreenUpdating = False
For Each c In [range("AJ9:AJ2000").specialcells(xlcelltypevisible)]
c = c.Formula
Next
Application.Calculation = xlAutomatic
 

Erakmur

XLDnaute Occasionnel
La personne qui a fait la macro a mis des crochets. J'en sais pas plus. Je constate jusque que cela fonctionne mais comme la macro s'exécute sur les 2000 cellules ca prend plusieurs minutes de calcul alors que sur les 2000 cellules il y en a qu'une centaine qui ne sont pas vides donc une grosse perte de temps

J'ai essayé la formule sans les crochets
Application.Calculation = xlManual
Application.ScreenUpdating = False
For Each c In Range("AJ9:AJ2000").SpecialCells(xlCellTypeVisible)
c = c.Formula
Next
Application.Calculation = xlAutomatic
End Sub

C'est l'erreur 1004 qui apparait
 

Erakmur

XLDnaute Occasionnel
En plus du fichier, voici la macro complète associée au bouton bleu "actualisation du planning de maintenance"

Sub Validation()
Dim c As Range
Sheets("2. Relevé Equipem. Prise en ch.").Select
Range("G4:I2000").Select
Selection.Copy
Sheets("3. Création du planning").Select
Range("E9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("2. Relevé Equipem. Prise en ch.").Select
Range("p4:q2000").Select
Selection.Copy
Sheets("3. Création du planning").Select
Range("h9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("2. Relevé Equipem. Prise en ch.").Select
Range("j4:j2000").Select
Selection.Copy
Sheets("3. Création du planning").Select
Range("t9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("2. Relevé Equipem. Prise en ch.").Select
Range("r4:r2000").Select
Selection.Copy
Sheets("3. Création du planning").Select
Range("u9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("2. Relevé Equipem. Prise en ch.").Select
Range("s4:s2000").Select
Selection.Copy
Sheets("3. Création du planning").Select
Range("aj9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.Calculation = xlManual
Application.ScreenUpdating = False
For Each c In [Aj9:Aj2000]
c = c.Formula
Next
Application.Calculation = xlAutomatic
End Sub
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Re
essaie ce code dans ton fichier AVEC des données
VB:
Sub Validation()
Dim Fin As Long
Dim c As Range
Dim FullRange As Range

With Sheets("2. Relevé Equipem. Prise en ch.") 'dans la feuille....
    Fin = .UsedRange.Rows.Count 'on récupère la dernière ligne utilisée de la feuille
    Set FullRange = .Range("A4:AZ" & Fin) 'on set tout le tableau
End With

'on applique des filtres et on copie colle le résultat
With FullRange
    .AutoFilter Field:=7, Criteria1:="<>" 'filtre sur la colonne G
'colonnes G:I vers E
    .Columns(7).Resize(, 3).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("E9")
'colonnes P:Q vers H
    .Columns(26).Resize(, 2).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("H9")
'Colonnes J vers t
    .Columns(10).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("t9")
'Colonnes R vers u
    .Columns(28).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("u9")
'Colonnes T vers AJ
    .Columns(29).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("AJ9")

End With

'Application.Calculation = xlManual
'Application.ScreenUpdating = False
'For Each c In [Aj9:Aj2000]
'c = c.Formula
'Next
'Application.Calculation = xlAutomatic
End Sub
 

vgendron

XLDnaute Barbatruc
Celui ci pour éviter de refraichir l'écran entre deux opérations
et pour supprimer le filtre à la fin
VB:
Sub Validation()
Application.ScreenUpdating = False
Dim Fin As Long
Dim c As Range
Dim FullRange As Range

With Sheets("2. Relevé Equipem. Prise en ch.") 'dans la feuille....
    Fin = .UsedRange.Rows.Count 'on récupère la dernière ligne utilisée de la feuille
    Set FullRange = .Range("A4:AZ" & Fin) 'on set tout le tableau
End With

'on applique des filtres et on copie colle le résultat
With FullRange
    .AutoFilter Field:=7, Criteria1:="<>" 'filtre sur la colonne G
'colonnes G:I vers E
    .Columns(7).Resize(, 3).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("E9")
'colonnes P:Q vers H
    .Columns(26).Resize(, 2).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("H9")
'Colonnes J vers t
    .Columns(10).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("t9")
'Colonnes R vers u
    .Columns(28).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("u9")
'Colonnes T vers AJ
    .Columns(29).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("AJ9")
    .AutoFilter 'suppression du filtre
End With
Application.ScreenUpdating = True
'Application.Calculation = xlManual
'Application.ScreenUpdating = False
'For Each c In [Aj9:Aj2000]
'c = c.Formula
'Next
'Application.Calculation = xlAutomatic
End Sub
 

Erakmur

XLDnaute Occasionnel
Cela ne fonctionne pas.

'Colonnes T vers AJ
.Columns(29).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("3. Création du planning").Range("AJ9")

C'est la colonne S qui faut copier sur AJ. A quoi correspond la colonne 29 ? La colonne S est la 19 la colonne.

Tu l'as sans doute remarqué mais j'ai fais la macro avec l'enregistreur pour les copier coller et une personne à fait le système de validation des cellules qui simule une sélection d'une cellule + entrée et cela 2000 fois.
 

vgendron

XLDnaute Barbatruc
ok, je me suis un peu planté....:-D, mais, j'ai des excuses.. suis en vacances ce soir ! :-D
la Fullrange comprend les colonnes de A à AJ
ensuite..il faut juste corriger mes indices..
colonnes PQ: 16 et pas 26
colonne R = 18
colonne T = 20 et pas 29

on est d'accord que le resize(,1) ne sert à rien puisqu'on ne prend qu'une seule colonne.. mais c'était juste par "esthétique" de la macro
par contre pour les colonnes P à Q: on fait un resize(,3) pour prendre les 3 colonnes

pour ta macro, je me doutais bien de la méthode utilisée, avec tous ces select inutiles qui ralentissent le code

après.. comme tu fais un copier collage spécial valeur, je ne comprend pas bien l'utilité de la deuxième partie de ton code c=c.formula
mais peut etre que je n'ai pas vu un point important: si c'est le cas, il faudrait que tu renvoies ton fichier avec quelques données, qu'on se rende mieux compte.
 

Erakmur

XLDnaute Occasionnel
Bonjour,
Désolé pour le retard. En fait, c'est la dernière partie justement qui pose problème:
'For Each c In [Aj9:Aj2000]
'c = c.Formula
Il applique la formule pour chaque ligne de AJ9 à AJ2000 et ca prend un temps fou. Il faudrait qu'il applique la formule pour chaque cellule de AJ9 à AJ2000 NON VIDE.
https://www.cjoint.com/c/IJlmCcnl6DL
Cordialement
 

Discussions similaires


Haut Bas