Tableaux dans vba

akni

XLDnaute Nouveau
Bonjour,
J'ai un tableau des quantités vendues par articles, clients et mois, je veux faire une récap par client sans passer par TCD quand j'utilise la méthode FOR NEXT elle tarde un peu, je crois qu'avec les tableaux Ubound et Lbound le résultat sera rapide.
ci joint mon fichier avec la macro FOR NEXT.


Merci beaucoup pour toute aide.
 

Pièces jointes

  • test Tableau 2.xlsm
    1.8 MB · Affichages: 116

Dranreb

XLDnaute Barbatruc
Ça dépend de la solution que tu veux mettre en œuvre pour ça.
Il vaut mieux une nouvelle colonne en fin qui n’interagit pas avec ce qu'il peut y avoir dedans à d'autres lignes.
La plus simple c'est avec une MeFC. Dans ce cas il ne reste qu'à mettre le format de nombre ;;; pour que le contenu de la colonne en cause ne se voie pas. Sinon un With LaFameuseColonne.SpecialCells(xlCelTypeConstants).EntireRow sera une excellente 1ère instruction pour y changer .Font (.Color, .Bold) et .Interior.Color, et la colonne ayant servi de critère peut ensuite être supprimée.
 

KIM

XLDnaute Accro
Bonjour Dranreb,
J'ai créé la col avec valeur = 1 et formaté la ligne selon une boucle classique :
Code:
For L = 5 To derl
            If FTS.Range("O" & L).Value = 1 Then
                FTS.Range("C" & L, "N" & L).Interior.ColorIndex = 6
                FTS.Range("C" & L, "N" & L).Font.Bold = True
                FTS.Range("C" & L, "N" & L).NumberFormat = "#,##0"
            End If
    Next L
Je n'ai pas réussi à utiliser ta méthode avec
With LaFameuseColonne.SpecialCells(xlCelTypeConstants).EntireRow
sachant que sur une feuille j'ai plusieurs tableaux et sont créés de la manière suivante :
'CFIN est déjà calculé et = 13
'FTS.[C4].Resize(100, CFIN).ClearContents
'FTS.[C4].Resize(L, CFIN).Value = TS

Merci d'avance de ton aide pour intégrer ce formatage après avoir recopié le tableau TS à partir d'une cellule C4 par exemple.
KIM
 

Pièces jointes

  • ColorierCond2.xlsm
    23.8 KB · Affichages: 23

Dranreb

XLDnaute Barbatruc
Bonjour
Si tu avais mis Option Explicit en tête du module tu aurais eu avant toute tentative d'exécution des messages clairs de variables non définies dans With FTS.Columns(O).SpecialCells(xlCelTypeConstants).EntireRow, d'abord sur xlCelTypeConstants, mal orthographié, c'est de ma faute et ensuite sur O, c'est de la tienne. Comme ça ça ne plante plus :
VB:
PlgDon.Interior.Color = xlNone
With FTS.Columns("O").SpecialCells(xlCellTypeConstants).EntireRow
   .Interior.ColorIndex = 6
   .Font.Bold = True
   .NumberFormat = "#,##0"
   End With
 

KIM

XLDnaute Accro
Merci Dranreb,
la ligne de code : With FTS.Columns("O").SpecialCells(xlCellTypeConstants).EntireRow
formate toute la ligne (EntireRow).
Comment modifier cette ligne de code pour dire :
formater à partir de la 1è col du tableau en se déplaçant de CFIN -1 col
car
Mon souci est que j'ai plusieurs tableaux dans ma feuille et chaque tableau est recopié via :
dans mon exemple CFIN=13
FTS.[C4].Resize(25, CFIN).ClearContents
'FTS.[C4].Resize(L, CFIN).Value = TS
un autre
FTS.[R4].Resize(50, CFIN).ClearContents
'FTS.[R4].Resize(L, CFIN).Value = TS

Pour chaque tableau CFIN est calculée de la façon suivante :
Set DicTit = GigIdx.DicInvent(LOt, ColTitre, ColDep): CFin = ColDep + DicTit.Count + 1

Merci d'avance
KIM
 

Pièces jointes

  • ColorierCond3.xlsm
    26.7 KB · Affichages: 21

KIM

XLDnaute Accro
Mzeci Dranreb,
Cela fonctionne mais c'est limité pour mes feuilles avec un nombre de tableaux important.
Est-il possible de prendre en compte les 2 cas suivants dans la ligne de commande With Intersect ... ?

Modifier : With Intersect(FTS.[C:C].Resize(, CFIN - 1), FTS.Columns("O").SpecialCells(xlCellTypeConstants).EntireRow)
pour
1/ Comment modifier Intersect(FTS.[C:C]. pour prendre en compte le tableau suivant : de la C4 jusqu à 22 lignes au dessous, jusqu à la col CFIN
FTS.[C4].Resize(25, CFIN).ClearContents
'FTS.[C4].Resize(L, CFIN).Value = TS
2/ FTS.Columns("O").SpecialCells :
Je ne connais pas à l'avance la col O. je ne connais que la valeur CFIN : c'est CFIN colonnes après la col de départ col C.

Merci d avance
KIM
 

Dranreb

XLDnaute Barbatruc
De toute façon il n'y a pas de 1 dans la colonne CFIN ailleurs que dans les lignes où tu l'a mis alors tu peux bien prendre les colonnes entières, non ? Ou alors définit une RngRés pour la manipuler plus facilement. Moi c'est ce que je ferais. Set RngRés = FTS.[C4].Resize(25, CFin) comme ça c'est Intersect(RngRés, RngRés.Columns(CFin).EntireRow)
 
Dernière édition:

KIM

XLDnaute Accro
J'ai simplifié la présentation du résultat. En réalité j'ai plusieurs tableaux l'un derrière l'autre et ensuite d'autres tableaux à droite.
Sur la même feuille
FTS.[A4].Resize(10, CFin).ClearContents
FTS.[A4].Resize(L, CFin).Value = TSop
'
FTS.[A20].Resize(22, CFin).ClearContents
FTS.[A20].Resize(L, CFin).Value = TSopdpt
'
FTS.[A50].Resize(22, CFin).ClearContents
FTS.[A50].Resize(L, CFin).Value = TSopcho
'
FTS.[X4].Resize(500, CFin).ClearContents
FTS.[X4].Resize(L, CFin).Value = TSopDptEqp

Je vais tester ta proposition.
Merci encore
KIM
 

KIM

XLDnaute Accro
Voilà le code selon tes recommandations :
1/ j'ai formaté la ligne des titres du tableau avec :
With FTS.[C4].Resize(1, CFIN)
2/ le reste du tableau est formaté avec la ligne de code suivante :
With Intersect(RngRés, RngRés.Columns(CFIN).SpecialCells(xlCellTypeConstants).EntireRow)

As-tu des commentaires ou améliorations ?

Merci encore
KIM

VB:
Set RngRés = FTS.[C4].Resize(25, CFIN)
RngRés.Interior.Color = xlNone
RngRés.Font.ColorIndex = xlAutomatic

With FTS.[C4].Resize(1, CFIN)
   .Interior.ColorIndex = 11
   .Font.Bold = True
   .Font.ThemeColor = xlThemeColorDark1
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

With Intersect(RngRés, RngRés.Columns(CFIN).SpecialCells(xlCellTypeConstants).EntireRow)

   .Interior.ColorIndex = 6
   .Font.Bold = True
   .NumberFormat = "#,##0"
   End With
  
End Sub
 

Pièces jointes

  • ColorierCond4.xlsm
    32.2 KB · Affichages: 28

Dranreb

XLDnaute Barbatruc
Non, pas grand chose. Si ce n'est que FTS.[C4].Resize(1, CFIN) du coup c'est RngRés.Rows(1)
Quand on définit un Range c'est pour ne plus avoir à utiliser d'expression Worksheet.Range et par exemple si besoin la changer de place dans une seule instruction.
 

KIM

XLDnaute Accro
Pour mieux maitriser la ligne de code With Intersect(RngRés, RngRés.Columns(CFIN).SpecialCells(xlCellTypeConstants).EntireRow)
Comment je peux la modifier pour dire :
Si je retrouve le mot "Total" dans la 1è col du tableau, formater la ligne :
With Intersect(RngRés, RngRés.Columns(2).SpecialCells(xlCellTypeConstants).Find("Total").EntireRow)
ne formate que la ligne du 1ier "Total" trouvé.
Pourquoi?
Merci Dranreb
KIM
 

Dranreb

XLDnaute Barbatruc
Bon j'ai des fonctions de service qui renvoient un objet Range de cellules obéissant à une condition :
VB:
Function ColLignesOùRelat(ByVal CelDéb As Range, ByVal ColQuoi, ByVal OPé As String, ByVal Valeur) As Range
Rem. ——— Cellules partant de CelDéb dans sa colonne où la colonne ColQuoi est en relation Opé avec Valeur.
   Set ColLignesOùRelat = Intersect(LignesOùRelat(CelDéb, ColQuoi, OPé, Valeur), CelDéb.EntireColumn)
   End Function
Function LignesOùRelat(ByVal LigneDéb As Range, ByVal ColQuoi, ByVal OPé As String, ByVal Valeur) As Range
Rem. ——— Lignes entières partant de LigneDéb où la colonne ColQuoi est en relation Opé avec une Valeur.
   If Not IsNumeric(ColQuoi) Then ColQuoi = LigneDéb.Worksheet.Columns(ColQuoi).Column
   If VarType(Valeur) = vbString Then Valeur = """" & Replace(Valeur, _
      """", """""") & """" Else Valeur = Trim$(Str$(Valeur))
   Set LignesOùRelat = LignesOùCondR1C1(LigneDéb, CondR1C1:="RC" & ColQuoi & OPé & Valeur)
   End Function
Function ColLignesOùCondR1C1(ByVal CelDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Cellules partant de CélDéb dans sa colonne dont les lignes vérifient une condition R1C1 CondR1C1.
   Set ColLignesOùCondR1C1 = Intersect(LignesOùCondR1C1(CelDéb, CondR1C1), CelDéb.EntireColumn)
   End Function
Function LignesOùCondR1C1(ByVal LigneDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Lignes entières partant de LigneDéb qui vérifient une condition R1C1 CondR1C1.
   Dim Lignes As Range, ColTrv As Range
   With LigneDéb.Worksheet.UsedRange
      Set Lignes = LigneDéb.EntireRow.Resize(.Rows.Count + .Row - LigneDéb.Row)
      Set ColTrv = Intersect(.Columns(.Columns.Count + 1), Lignes): End With
   ColTrv.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
   On Error Resume Next
   Set LignesOùCondR1C1 = ColTrv.SpecialCells(xlCellTypeFormulas, 1).EntireRow
   ColTrv.Delete xlShiftToLeft
   End Function
Le truc c'est qu'elles partent d'une ligne spécifiée et l'applique pour tout le reste de la feuille. Alors il faudrait soit que tous les tableaux aient ce "Total" dans la même colonne soit faire ces mises en forme après constitution de chaque tableau.
Mais ça permettrait d'écrire un truc du genre :
VB:
With ColLignesOùCondR1C1(RngRés, "LEFT(RC3,5)=""Total""")
 
Dernière édition:

KIM

XLDnaute Accro
Bonjour Dranreb,
Merci pour ces fonctions, elles vont m'être utiles. je vais les tester.
Est-ce que je peux copier ces fonctions dans le module MGigogne ou dans le module de classe SsGr, ou plustôt MTableaux ?
Ces fonctions et la fonction SpecialCells(xlCellTypeConstants) vont me faire gagner du temps. En effet, mon classeur "Carnet de bord" contient 29 feuilles de tableaux construits à partir de 4 feuilles de données. Le formatage de ces tableaux de bord est manuel, 1 fois à la construction du tableau. Mais s'il y a modification des titres selon les données, la mise à jour du formatage doit se faire manuellement aussi. Avec ce que j'ai appris ces 2 jours, je vais automatiser le formatage des tableaux de bord.
Si tu as d'autres fonctionnalités pratiques pour améliorer la construction et la présentation, je suis preneur.
Merci encore.
KIM
 

KIM

XLDnaute Accro
Bonjour Dranreb,
J'essaye d'utiliser tes fonctions.
Dans l'exemple, With ColLignesOùCondR1C1(RngRés, "LEFT(RC3,5)=""Total""")
RC3 veut dire même ligne, 3è colonne.
Le texte "Total de la ..." se trouve dans le 1è col du tableau. J'ai essayé plusieurs combinaison avec RC, RC1, Column(1) sans résultat.
Comment dire dans With ColLignesOùCondR1C1(RngRés, "LEFT(....)=""Total""") que la col de référence est la colonne 1 du tableau?

Merci d'avance
KIM
 

Discussions similaires

Réponses
1
Affichages
321