Demande d'exemple pour compiler avec une boucle des données dans une autre feuille

zephir94

XLDnaute Impliqué
Bonjour à tous,

Ayant bien avancé dans le monde du vba je voudrais passer à l'étape suivante en récupérant des données d'une feuille pour les trier dans un tableau d'une autre.
J'ai fourni un fichier exemple, si l'un d'entre vous pouvez me détailler le code je l'en remercie par avance
 

Pièces jointes

  • Classeur1.xls
    21.5 KB · Affichages: 63
  • Classeur1.xls
    21.5 KB · Affichages: 72
  • Classeur1.xls
    21.5 KB · Affichages: 66

job75

XLDnaute Barbatruc
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

Bonjour zephir94, Si...

Tu as tout a fait raison Si..., 2 boucles suffisent, donc je modifie à partir de mon post #11 :

Code:
Private Sub Worksheet_Activate()
Dim deb As Range, ncol%, base, t(), i&, m As Byte, j%
Set deb = [A1] '1ère cellule, à adapter
ncol = 6 'nombre de colonnes du tableau, à adapter
base = Feuil1.UsedRange.Resize(, ncol) 'tableau, CodeName de la feuille
ReDim t(1 To 12, 1 To ncol - 1) 'tableau base 1
For i = 2 To UBound(base)
  If IsDate(base(i, 1)) Then
    m = Month(base(i, 1))
    For j = 2 To ncol
      If base(i, j) <> "" Then t(m, j - 1) = t(m, j - 1) + 1
    Next j
  End If
Next i
deb(2, 2).Resize(12, ncol - 1) = t 'restitution dans la feuille
'---titres---
deb.Resize(, ncol) = Application.Index(base, 1, 0)
deb(2).Resize(12).FormulaArray = "=UPPER(TEXT(""1/""&ROW(1:12),""mmm""))"
deb(2).Resize(12) = deb(2).Resize(12).Value
End Sub
Je répète pour zephir94 : traiter des tableaux VBA est toujours plus rapide que de traiter des plages de cellules.

Bonne journée.
 

zephir94

XLDnaute Impliqué
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

Bonjour Job75,

Ne vous vexez pas j'a bien compris après lecture de beaucoup de documents que le fait d'utiliser un tableau va grandement accélérer le traitement, surtout avec un gros volume de données !
Mais je vais y aller progressivement, votre code était pour l'instant bien au delà de ce que je pouvais d'un premier jet comprendre.
J'ai bien compris la logique de la boucle et j'ai réussi à la reproduire grâce à l'exemple suivant gentiment proposé pa Si...

Votre code avec le tableau m'intéresse mais pour l'instant je n'arrive pas à saisir son déroulement, mais je vais m'atteler à essayer de le comprendre en m'appuyant sur ses deux boucles.
Je continu reconnaissance sur le sujet car j'ai vraiment envie d’acquérir cela !
à ce soir pour la suite de mon apprentissage :rolleyes:
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

Re,

Si vous lisiez mes macros vous verriez que je teste la colonne A avec IsDate.

Pour ne pas traiter les lignes où en colonne A ce n'est pas une date.

A+
 

zephir94

XLDnaute Impliqué
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

Merci Job75 pour cette précision,

Je lis avec beaucoup d'attention vos macros et je l'ai bien remarqué a cet endroit
If IsDate(base(i, 1)) Then
m = Month(base(i, 1))

Mais je me posait la question comment par exemple remplacer dans l'exemple de Si... des dates par des Noms par exemple, j'essaie de bien comprendre et une fois cela fait j'essaye de l'intégrer dans un tableau
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

Re,

Bah vous n'avez même pas digéré les choses simples que vous en voulez des compliquées :

Code:
Private Sub Worksheet_Activate()
Dim deb As Range, ncol%, base, d As Object, i&, n&, p&, j%
Set deb = [A1] '1ère cellule, à adapter
ncol = 6 'nombre de colonnes du tableau, à adapter
base = Feuil1.UsedRange.Resize(, ncol) 'tableau, CodeName de la feuille
'---liste des noms sans doublon---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(base)
  If base(i, 1) <> "" And Not d.exists(base(i, 1)) Then
    n = n + 1
    d(base(i, 1)) = n 'élimine les doublons et mémorise n
  End If
Next i
'---remplissage du tableau---
If n Then
  ReDim t(1 To n, 1 To ncol - 1) 'tableau base 1
  For i = 2 To UBound(base)
    If base(i, 1) <> "" Then
      p = d(base(i, 1))
      For j = 2 To ncol
        If base(i, j) <> "" Then t(p, j - 1) = t(p, j - 1) + 1
      Next j
    End If
  Next i
  Application.ScreenUpdating = False
  deb(2).Resize(n) = Application.Transpose(d.keys) 'titres colonne A
  deb(2, 2).Resize(n, ncol - 1) = t 'restitution dans la feuille
  deb.Resize(n + 1, ncol).Sort deb, Header:=xlYes 'tri sur les noms
  deb.Resize(n + 1, ncol).Borders.Weight = xlThin 'bordures
End If
deb.Resize(, ncol) = Application.Index(base, 1, 0) 'titres ligne 1
Range(deb(n + 2), Rows(Rows.Count)).Delete 'RAZ en dessous
End Sub
Fichier joint.

A+
 

Pièces jointes

  • Classeur(1).xls
    42.5 KB · Affichages: 31
  • Classeur(1).xls
    42.5 KB · Affichages: 25
  • Classeur(1).xls
    42.5 KB · Affichages: 29

job75

XLDnaute Barbatruc
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

Re,

Une solution meilleure mais plus difficile à comprendre :

Code:
Private Sub Worksheet_Activate()
Dim deb As Range, ncol%, base, d As Object, i&, n&, t(), p&, j%
Set deb = [A1] '1ère cellule, à adapter
ncol = 6 'nombre de colonnes du tableau, à adapter
base = Feuil1.UsedRange.Resize(, ncol) 'tableau, CodeName de la feuille
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(base)
  If base(i, 1) <> "" Then
    If Not d.exists(base(i, 1)) Then
      n = n + 1
      d(base(i, 1)) = n 'élimine les doublons et mémorise n
      ReDim Preserve t(1 To ncol, 1 To n) 'tableau base 1
      t(1, n) = base(i, 1)
    End If
    p = d(base(i, 1))
    For j = 2 To ncol
      If base(i, j) <> "" Then t(j, p) = t(j, p) + 1
    Next j
  End If
Next i
If n Then
  Application.ScreenUpdating = False
  With deb(2).Resize(n, ncol)
    .Value = Application.Transpose(t) 'restitution
    .Sort deb, Header:=xlNo 'tri sur les noms
    .Borders.Weight = xlThin 'bordures
  End With
End If
deb.Resize(, ncol) = Application.Index(base, 1, 0) 'titres ligne 1
Range(deb(n + 2), Rows(Rows.Count)).Delete 'RAZ en dessous
End Sub
- le tableau base n'est parcouru qu'une seule fois

- le tableau t (transposé) est redimensionné au fur et à mesure.

Fichier (2).

A+
 

Pièces jointes

  • Classeur(2).xls
    41.5 KB · Affichages: 18
  • Classeur(2).xls
    41.5 KB · Affichages: 25
  • Classeur(2).xls
    41.5 KB · Affichages: 27

zephir94

XLDnaute Impliqué
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

Merci Job75,

Je vous remercie infiniment mais j'essaie de bien maitriser la solution de Si... qui me permet déjà de continuer mon apprentissage sur les boucles.
J'ai bien compris le message sur les tableaux qui permettent d'accélérer le traitement dans Excel.
Pour l'instant il est vrai que je la solution tableau n'est pas encore de mon niveau.
Cela fait 9 mois que je suis passé au VBA et je penses qu'un jour forcement vous avez été comme moi débutant, et c'est pas en une semaine que vous avez acquis l'extraordinaire maitrise où vous en êtes !

Ma question pour l'instant est seulement pour essayer progressivement de m'améliorer comment transformer le code de Si... dans le cas ou j'aurais des noms au lieu des dates dans son exemple !
Encore merci pour tout
 

zephir94

XLDnaute Impliqué
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

J'ai trouvé

Code:
Private Sub test2()
  Dim R As Range, L As Byte, C As Byte, Nom
  [B2:F9] = ""
  With Feuil3
    For Each R In .[A2:A9]
      L = (R.Row)
      For C = 2 To 6
        If .Cells(R.Row, C) = "x" Then Cells(L, C) = Cells(L, C) + 1
      Next
    Next
  End With
End Sub

il suffisait de remplacer par
Code:
 L = (R.Row)

L représentant la ligne R la Cellule et row la ligne !
Je ne demande pas plus que d'être aider à avancer et surtout à comprendre !
 
Dernière édition:

zephir94

XLDnaute Impliqué
Re : Demande d'exemple pour compiler avec une boucle des données dans une autre feuil

Je me suis amusé à étendre la liste jusqu'à la dernière ligne remplie comme ceci :

Code:
Private Sub test2()
  Dim R As Range, L As Byte, C As Byte, Nom, u As Long
[B2:F9] = ""
  With Feuil3
    u = Feuil3.Range("A65536").End(xlUp).Row
    'For Each R In .[A2:A9]
      For Each R In .Range("A2" & ":A" & u)
      L = (R.Row)
      For C = 2 To 6
        If .Cells(R.Row, C) = "x" Then Cells(L, C) = Cells(L, C) + 1
      Next
    Next
  End With
End Sub

Par contre je m'aperçois que les colonnes doivent correspondre d'une feuille à l'autre ?
car même en décalant
Code:
For C = 3 To 7
ça ne marche pas il décale d'une colonne et je perd la première colonne en récupération !
 

Discussions similaires

Statistiques des forums

Discussions
312 216
Messages
2 086 351
Membres
103 195
dernier inscrit
martel.jg