Problème d'autofill sur ligne unique

Sofhy

XLDnaute Occasionnel
Bonjour à tous,

J'utilise la fonction autofill pour tirer une formule vers le bas.
Mon nombre de lignes et de données sont variables et il peut arriver que je me retrouve avec une seule ligne. Dans ce cas, la macro ne fonctionne pas.

Savez-vous comment je peux contourner ce problème ?

Je vous joins mon fichier.
Si vous lancez la macro depuis l'onglet "fonctionne", et bien ça fonctionne :D car en colonne D, j'ai deux magasins différents.
Par contre, si vous lancez la macro sur l'onglet "fonctionne pas", je n'ai qu'un seul magasin en colonne D et donc problème.

Merci par avance pour votre aide,
Sofhy
 

Pièces jointes

  • Pb Autofil.xls
    43.5 KB · Affichages: 78

Pierrot93

XLDnaute Barbatruc
Re : Problème d'autofill sur ligne unique

Bonsoir Sofhy,

peut être en effectuant un petit test...

Code:
Dim a As Range
Set a = Range("D2:D" & Range("D65536").End(xlUp).Row)
If Application.CountIf(a, Range("D2")) = a.Count Then
    Exit Sub
Else
    'ton code
End If

bonne soirée
@+
 

Sofhy

XLDnaute Occasionnel
Re : Problème d'autofill sur ligne unique

Bonjour Pierrot93,

J'ai une erreur, mais je pense que je ne place pas ton script au bon endroit (je t'ai joint le fichier avec mon "insertion").

Par contre, ayant retenue la leçon de la dernière fois, si on indique "Exit Sub", la suite du code ne va pas être pris en compte dans le cas où je n'ai qu'un magasin ?

Sofhy
.
 

Pièces jointes

  • Pb Autofil-2.zip
    15.9 KB · Affichages: 39

Pierrot93

XLDnaute Barbatruc
Re : Problème d'autofill sur ligne unique

Re,

Par contre, ayant retenue la leçon de la dernière fois, si on indique "Exit Sub", la suite du code ne va pas être pris en compte dans le cas où je n'ai qu'un magasin ?

exacte, si ce n'est pas ce que tu veux, modifie ainsi :
Code:
Dim a As Range
Set a = Range("D2:D" & Range("D65536").End(xlUp).Row)
If Not Application.CountIf(a, Range("D2")) = a.Count Then _
    Range(NbPV).AutoFill Destination:=Range(NbPV & ":E" & Range("D65536").End(xlUp).Row)

A noter, ce code doit être placé avant d'écrire dans la colonne D....

petite remarque au passage, il est préférable de placer toutes les déclarations de vraiable sur les premières lignes de la procédure... plus facile à lire...

bonne soirée
@+
 

Sofhy

XLDnaute Occasionnel
Re : Problème d'autofill sur ligne unique

Bonjour Pierrot93,

Me revoici après un week-end passé loin de l'ordinateur, mais ça ne m'a visiblement pas porté conseil.

Je n'arrive pas à employer ton code. Et je ne suis pas assez avancée pour comprendre l'erreur. Alors j'ai essayé de le positionner avant ou après tel ou tel autre code, mais sans succès. Ca fonctionne uniquement dans l'un des deux cas.

Help :(
Sofhy
 

Pierrot93

XLDnaute Barbatruc
Re : Problème d'autofill sur ligne unique

Bonjour Sofhy,

A vérifier, peut être ici :
Code:
    Range("E1").End(xlDown).Offset(4, 0).Select
    NbPV = Selection.Address
    
Dim a As Range
Set a = Range("D2:D" & Range("D65536").End(xlUp).Row)
If Not Application.CountIf(a, Range("D2")) = a.Count Then _
    Range(NbPV).AutoFill Destination:=Range(NbPV & ":E" & Range("D65536").End(xlUp).Row)
        
    Range("D1").Select
    Range(Selection, Selection.End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range(PV), Unique:=True

bonne journée
@+
 

Pierrot93

XLDnaute Barbatruc
Re : Problème d'autofill sur ligne unique

Re,

j'ai finalement un peu modifier ton code, en supposans que tu n'ais pas de ligne vide mais au moins 1 de renseignée ...

Code:
Option Explicit
Sub Ma_Macro()
Dim a As Range

Columns("G:G").Insert Shift:=xlToRight
Columns("J:J").Insert Shift:=xlToRight

Range("G1").FormulaR1C1 = "Gamme"
Range("J1").FormulaR1C1 = "VD - VK ?"
Range("N1").FormulaR1C1 = "Part / Sté"

Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(0, 4)
Columns("I:I").TextToColumns Destination:=Range("I1"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(0, 4)
Columns("M:M").TextToColumns Destination:=Range("M1"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(0, 4)
Columns("F:F").TextToColumns Destination:=Range("F1"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(0, 1)

Range("G2").FormulaLocal = "=SI(ESTERREUR(RECHERCHEV(F2;Criteres!A:B;2;FAUX));Mod_a_creer;RECHERCHEV(F2;Criteres!A:B;2;FAUX))"
Range("G2").AutoFill Destination:=Range("G2:G" & Range("A65536").End(xlUp).Row)

With Range("G2:G" & Range("A65536").End(xlUp).Row)
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""Modèle à créer"""
    .FormatConditions(1).Interior.ColorIndex = 3
End With
    
If Application.CountIf(Range("G2", Range("G65536").End(xlUp)), "Mod_a_creer") > 0 Then
    MsgBox "Attention!!! Vous devez créer les  Modèles manquants dans l'onglet critères"
    Exit Sub
End If
    
Range("J2").FormulaLocal = "=SI(K2=""oui"";""Stock VD"";SI(L2=""oui"";""Stock VK"";""""))"
Range("J2").AutoFill Destination:=Range("J2:J" & Range("A65536").End(xlUp).Row)

With Range("N2:S" & Range("A65536").End(xlUp).Row).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=P_Ste"
End With

With Range("E65536").End(xlUp)(4)
    .Value = "Nb"
    .Font.Bold = True
End With

Range("D1", Range("D65536").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1").End(xlDown)(4), Unique:=True

With Range("C65536").End(xlUp)(4)
    .Value = "Nb"
    .Font.Bold = True
End With

Range("B1", Range("B65536").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1").End(xlDown)(4), Unique:=True

With Range("E65536").End(xlUp)(2)
    .FormulaLocal = "=NB.SI(" & Range("D1:D" & Range("D1").End(xlDown).Row).Address & ";" & .Offset(0, -1).Address(0, 0) & ")"
    If .Value < Range("D2", Range("D2").End(xlDown)).Count Then
        .AutoFill Destination:=Range(.Address & ":E" & Range("D65536").End(xlUp).Row)
    End If
End With

With Range("C65536").End(xlUp)(2)
    .FormulaLocal = "=NB.SI(" & Range("B1:B" & Range("B1").End(xlDown).Row).Address & ";" & .Offset(0, -1).Address(0, 0) & ")"
    If .Value < Range("B2", Range("B2").End(xlDown)).Count Then
        .AutoFill Destination:=Range(.Address & ":C" & Range("B65536").End(xlUp).Row)
    End If
End With

End Sub
 

Sofhy

XLDnaute Occasionnel
Re : Problème d'autofill sur ligne unique

Bonjour Pierrot, le forum,

J'ai testé et ça ne fonctionne pas. Mais cette fois, le week-end a porté conseil et j'ai trouvé une solution :D

Alors ce n'est peut être pas très académique, ça peut surement être optimisé ou simplifié, mais ça fonctionne.

Le principe : si le numéro de la deuxième cellule d'extraction est égale au numéro de la dernière cellule de la colonne, alors c'est qu'il n'y a qu'un seul magasin et je n'utilise pas l'autofill.
Dans le cas contraire, j'en ai plusieurs, donc j'utilise l'autofill.

Voici mon bout de code et je joins également le fichier complet.

Code:
'TEST SI MAGASIN UNIQUE OU PAS
Dim TestPv1 As String
    Range("D65536").End(xlUp).Select
    TestPv1 = Split(Selection.Address, "$")(2)
Dim TestPv2 As String
    Range(CritPV).Select
    TestPv2 = Split(Selection.Address, "$")(2)
Range(NbPV).FormulaLocal = "=NB.SI(" & PlagePv & ";" & CritPV & ")"
If TestPv1 <> TestPv2 Then Range(NbPV).AutoFill Destination:=Range(NbPV & ":E" & Range("D65536").End(xlUp).Row)

Merci encore pour ton aide,
Bon dimanche,
Sophie
 

Pièces jointes

  • Pb Autofil 3.xls
    44.5 KB · Affichages: 67

Staple1600

XLDnaute Barbatruc
Re : Problème d'autofill sur ligne unique

Bonjour


Deux petits conseils en passant

Tu peux éviter les Select dans ton code VBA
(Cela a l'avantage entre autre d'alléger ton code VBA)
(Voir ci-dessous)
Code:
Dim TestPv1 As String, TestPv2 As String
TestPv1 = Split(Range("D65536").End(xlUp).Address, "$")(2)
TestPv2 = Split(Range(CritPV).Address, "$")(2)
Par convention , normalement les déclarations de variables
se font en début de procédure
Exemple
Code:
Sub a()
Dim Titre As String, Message As String, Bouton As Long
Dim Utilisateur As String

Utilisateur = Application.UserName
Titre = "Information"
Message = "Bonjour" & vbLf & Utilisateur
Bouton = 64

MsgBox Message, Bouton, Titre
End Sub
 
Dernière édition:

Sofhy

XLDnaute Occasionnel
Re : Problème d'autofill sur ligne unique

Bonjour Staple1600,

Merci pour les conseils.

J'ai beaucoup de difficultés à optimiser en supprimant les "select". Des progrès sont à faire sur la syntaxe.
Alors, à chaque fois que l'on me donner un raccourci, je le note ;)

Pour les variables, Pierrot m'a déjà fait la remarque. Il faut que me discipline :D.
Comme je patauge un peu, je me rends compte des variables dont j'ai besoin au fur et à mesure que j'avance dans mon fichier, et je les laisse juste à côté du code où elles sont employées pour tester si ça fonctionne. Il faudrait effectivement que je mette un peu d'ordre là dedans, car il y en a partout !

Bonne journée,
Sofhy
 

Pierrot93

XLDnaute Barbatruc
Re : Problème d'autofill sur ligne unique

Bonjour Sophie, Staple

Quand tu dis que cela ne fonctionne pas.... il s'agit bien du code proposé le 16 août à 13h58 ? et ca ne fonctionne pas, veut dire quoi ? message d'erreur ou pas le résultat attendu ? chez moi ce code fonctionne et ce dans le classeur que tu avais fourni le 13 août...

bonne journée
@+
 

Sofhy

XLDnaute Occasionnel
Re : Problème d'autofill sur ligne unique

Bonjour Pierrot,

J'avais un message d'erreur lorsque je lançais ton code. Comme je ne savais plus quoi, je viens de refaire un test, et là, je suis confuse car ça fonctionne :eek:.

Oups, désolée ... j'ai du faire une mauvaise manipulation.

Merci encore,
Sophie
 

Discussions similaires

Statistiques des forums

Discussions
312 297
Messages
2 086 972
Membres
103 412
dernier inscrit
antoire