Help Correction Code Vba

[Sofhy]

Bonjour à tous,

J'aurais besoin de votre aide pour corriger un code.
J'ai des données brutes dans une feuille que je dois mettre en forme + quelques formules. J'ai pas trop mal avancé, mais je bloque (pour l'instant ) sur deux problèmes.

- Mon premier problème - Dans le Sub Mise_en_forme()
Je Fusionne plusieurs cellules, mais le texte ne se centre pas.
J'ai le mois et l'année qui s'affiche en 4 - 2010. Est-il possible de l'afficher en Avril 2010 ? (J'ai mis le commentaire en majuscule dans le code pour un meilleur repérage).

- Mon second problème - Dans le Sub Sous_Totaux()
Là, tout le code est en erreur. Avec des noms de cellules bien définis, il fonctionne (le Sub Ki_Fonctionne). Dès que je tente de placer des variables, patatra !!
Je veux sélectionner toute la liste des vendeurs en colonne C (variable DerVendeur pour la dernière cellule de la colonne). Puis placer l'extraction sans doublons deux cellules en dessous du tableau (DerVendeurT).

Je vous joins un petit fichier.
Merci par avance,
Sofhy

PS : j'utilise pas mal l'enregistreur de macro (début oblige), si vous avez des remarques d'optimisation comme

Range("E2").End(xlDown).Offset(1, 0).Select
 au lieu de 
[Range("E2").Select
Selection.End(xlDown).Offset(1, 0).Select

N'hésitez surtout pas, je prends

 

[Guest]

Re : Help Correction Code Vba

Bonjour,

Pour la sub des sous totaux:

Sub Sous_Totaux()
Dim DerVendeur As [COLOR=red][B]Long[/B][/COLOR]
Dim dervendeurT As [COLOR=red][B]Long[/B][/COLOR]
'dervendeur sélectionne la dernière cellule du tableau. Sélection pour l'extration des doublons
DerVendeur = Range("C3").End(xlDown).[COLOR=red][B]Row[/B][/COLOR]
'DervendeurT permet de situer la cellule où l'extraction sans doublon va commencer, à savoir la dernière cellule de la colonne C +2
dervendeurT = Range("C3").End(xlDown).Offset(0, 2).Select
    Range("C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("C3:C" & DerVendeur).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "C" & dervendeurT), Unique:=True
End Sub

Pour le format Date:

   ActiveCell.FormulaR1C1 = "=TEXT(R2C2,""mmmm - aaaa"")"

 

[tototiti2008]

Re : Help Correction Code Vba

Bonjour Sofhy, Bonjour Hasco,

1)

Même si Hasco a répondu, le petit + sur le centrage dans la cellule fusionnée :

    Selection.Merge
    Selection.HorizontalAlignment = xlCenter
'ICI SE TROUVE MON PREMER PB. COMMENT METTRE LE MOIS EN TOUTE LETTRE ?
    ActiveCell.FormulaR1C1 = "=text(R[3]C,""MMMM AAAA"")"

2)

Sub Sous_Totaux()
Dim DerVendeur As Long
Dim dervendeurT As Long
'dervendeur sélectionne la dernière cellule du tableau. Sélection pour l'extration des doublons
DerVendeur = Range("C3").End(xlDown).[B]Row[/B]
'DervendeurT permet de situer la cellule où l'extraction sans doublon va commencer, à savoir la dernière cellule de la colonne C +2
dervendeurT = Range("C3").End(xlDown).Offset[B](2, 0).Row 'C'est 2 lignes de +[/B]
    Range("C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("C3:C" & DerVendeur).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "C" & dervendeurT), Unique:=True
End Sub

 

[JNP]

Re : Help Correction Code Vba

Bonsoir le fil ,
Moi j'ai fait un peu de nettoyage, et par contre, j'ai plutôt mis la date "en dur" .

Sub Mise_en_forme()
'Supprime la colonne A
    Columns("A:A").Delete Shift:=xlToLeft
'Inscrit le nom des titres
    Range("A1") = "Jours"
    Range("B1") = "N°Stock"
    Range("C1") = "Vendeur"
    Range("D1") = "PV"
    Range("E1") = "Clients"
    Range("F1") = "Gamme"
    Range("G1") = "Type"
    Range("H1") = "Bla"
    Range("I1") = "Bla"
    Range("J1") = "Bla"
    Range("K1") = "Bla"
    Range("L1") = "Bla"
    Range("M1") = "Bla"
 'Mettre la ligne de titre en couleur et gras.
    With Range("A1:M1")
    With .Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
        .Font.Bold = True
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
'Insérer les deux lignes, puis inscrire le mois et l'année
    Rows("1:2").Insert Shift:=xlDown
    Range("A1:M1").Merge
    Range("A1:M1").HorizontalAlignment = xlCenter
'ICI SE TROUVE MON PREMER PB. COMMENT METTRE LE MOIS EN TOUTE LETTRE ?
    Range("A1") = Format(Range("A4"), "mmmm - yyyy")
    'Elargir les colonnes
    Cells.EntireColumn.AutoFit
    Columns("J:J").ColumnWidth = 11.86
    Columns("K:K").ColumnWidth = 10.43
    Columns("L:L").ColumnWidth = 5.14
    Columns("M:M").ColumnWidth = 19.43
'Sélectionner tout le tableau et le quadriller
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub

Bonne soirée .

 

[Guest]

Re : Help Correction Code Vba

Hello boys!

Où l'on voit les courageux

A++

 

[Sofhy]

Re : Help Correction Code Vba

Ouh la la,

Autant de réponses en si peu de temps !

Merci à tous,
Bonne fin de journée,
Sofhy