XL 2016 Données classées

Jean Jan

XLDnaute Junior
Bonjour à tous,

Est-il possible de regrouper les données de la feuille « DEF » colonne « code » commençant par « AA : » dans la feuille « DET »

Merci pour votre aide.;)
 

Pièces jointes

  • Classeur1.xlsx
    20.7 KB · Affichages: 28

Jocelyn

XLDnaute Barbatruc
Bonjour le Forum,
Bonjour Jean Jean,

Un essai en fichier joint les colonnes C et G comporte des formules matricielles dans toutes les formules il y a des plages nommées pour les voir aller dans l'onglet formule du ruban et gestionnaire de noms, toutes les plages nommées sont dynamique elles s'actualisent si tu ajoutes des données

Cordialement
 

Pièces jointes

  • Jean jean.xlsx
    22.1 KB · Affichages: 21

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

Une proposition VBA qui récupère les données de toutes les villes...

VB:
Sub Macro1()
Dim F As Worksheet 'déclare la variable F (onglet DEF)
Dim T As Worksheet 'déclare la variable T (onglet DET)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire D)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set F = Worksheets("DEF") 'définit l'onglet F
Set T = Worksheets("DET") 'définit l'onglet T
T.Cells.ClearContents 'efface d'éventuelles anciennes données de l'onglet T
TV = F.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 3 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
  'si les deux premiers caractères de la donnée ligne I colonne 1 de TV sont "AA", alimente le dictionnaire D avec la donnée ligne I colonne 5 de TV
  If Left(TV(I, 1), 2) = "AA" Then D(TV(I, 5)) = ""
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
  K = 1 'initialise la variable K
  For I = 3 To UBound(TV) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
  'condition : si les deux premiers caractères de la donnée ligne I colonne 1 de TV sont "AA" et si la donnée ligne I colonne 5 de TV correspond à TMP(J)
  If Left(TV(I, 1), 2) = "AA" And TV(I, 5) = TMP(J) Then
  ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
  For L = 1 To UBound(TV, 2) 'boucle 3 sur toutes les colonnes L du tableau des valeurs TV
  TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> transposition)
  Next L 'prochaine colonne de la boucle 3
  K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
  End If 'fin de la condition
  Next I 'prochaine ligne de la boucle 2
  'définit la cellule de destination DEST (A1 si A1 est vide sinon la seconde cellule vide de la ligne 1)
  If T.Range("A1").Value = "" Then Set DEST = T.Range("A1") Else Set DEST = T.Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 2)
  DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Index(TV, 2) 'renvoie DEST redimensionnée la seconde ligne du tableau des valeurs TV
  DEST.Offset(1, 0).Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'revoie dans DEST décalée d'une ligne et redimensionnée le tableau TL transposé
Next J 'prochain élément de la boucle 1
End Sub
 

Jean Jan

XLDnaute Junior
Bonjour Jocelyn,
Bonjour Robert,
Tout d’abord je vous remercie pour vos solutions :)
J’ai un petit problème avec les formules, je n’arrive pas à changer la sélection du tri (AA), en effet si je modifie la formule je me retrouve avec la 1ère ligne de la feuille « DEF »
Et avec la macro cela fonctionne mais les données sont misent a la suite dans la feuille « DET » (donc pas classées dans mes petit tableaux :()
Je suis désolé de ne pas être entièrement satisfait, mais bravo et un grand MERCI..
Jean Jan.
 

job75

XLDnaute Barbatruc
Bonsoir Jean Jan, Jocelyn, Robert,

Cette macro est à placer dans le code de la feuille "DEF" (clic droit sur l'onglet et Visualiser le code) :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim code As Range, ville As Range, t, xcode$, d As Object, i&, xville$, n&, a()
Set code = [H2]: Set ville = [J2] 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
ville(2).Resize(Rows.Count - ville.Row, 3).Delete xlUp 'RAZ
t = [A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
xcode = code & "*"
'---liste de validation des villes---
Set d = CreateObject("Scripting.Dictionary")
If code <> "" Then
    For i = 2 To UBound(t)
        If t(i, 1) Like xcode And LCase(t(i, 4)) = "oui" Then d(t(i, 5)) = ""
    Next
End If
ville.Validation.Delete
With [Z:Z] 'colonne auxiliaire
    .ClearContents
    If d.Count Then
        With .Resize(d.Count)
            .Value = Application.Transpose(d.keys)
            .Sort .Cells(1), xlAscending, Header:=xlNo 'tri alphabétique
            ville.Validation.Add xlValidateList, Formula1:="=" & .Address
        End With
    End If
End With
'---tableau des résultats---
If code = "" Or Application.CountIf([Z:Z], ville) = 0 Then ville = ""
xville = ville
If xville <> "" Then
    For i = 2 To UBound(t)
        If t(i, 1) Like xcode And LCase(t(i, 4)) = "oui" And t(i, 5) = xville Then
            n = n + 1
            ReDim Preserve a(1 To 3, 1 To n)
            a(1, n) = t(i, 1)
            a(2, n) = t(i, 3)
            a(3, n) = t(i, 2)
        End If
    Next
End If
If n Then
    With ville(2).Resize(n, 3)
        .Value = Application.Transpose(a)
        .Borders.Weight = xlThin
    End With
End If
Application.EnableEvents = True 'réactive les évènements
End Sub
Il y a un seul tableau de résultats où l'on choisit la ville en J2.

Bien entendu la feuille "DET" est totalement inutile.

Fichier joint.

A+
 

Pièces jointes

  • Classeur(1).xlsm
    40.3 KB · Affichages: 16
Dernière édition:

Jean Jan

XLDnaute Junior
Bonjour job75,
Un grand MERCI pour ta solution, :(
Mais la feuille "DET" m'est indispensable dans mon fichier,
en effet le feuille "DEF" est remplie au lancement de mon classeur,
et elle est le résultat de l'importation d'un csv et d'une macro de traitement de données....
Suite a cela la feuille "DEF" me sert de base de données et ne peut être modifiée... o_O
Et du coup toutes les données des localisation (Ville) doivent être mise en forme dans la feuille "DET" (en tableaux).
Mais pas toute les localisations, seulement certaines !!!!

Je ne sais pas si je suis clair...
Encore merci et bonne journée a tous....;)
 

job75

XLDnaute Barbatruc
Bonjour Jean Jan,
Mais la feuille "DET" m'est indispensable dans mon fichier,
Aucun problème, mettre le code dans la feuille "DET" :
Code:
Private Sub Worksheet_activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim code As Range, ville As Range, t, xcode$, d As Object, i&, xville$, n&, a()
Set code = [C2]: Set ville = [E2] 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
ville(2).Resize(Rows.Count - ville.Row, 3).Delete xlUp 'RAZ
t = Sheets("DEF").[A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
xcode = code & "*"
'---liste de validation des villes---
Set d = CreateObject("Scripting.Dictionary")
If code <> "" Then
    For i = 2 To UBound(t)
        If t(i, 1) Like xcode And LCase(t(i, 4)) = "oui" Then d(t(i, 5)) = ""
    Next
End If
ville.Validation.Delete
With [Z:Z] 'colonne auxiliaire
    .ClearContents
    If d.Count Then
        With .Resize(d.Count)
            .Value = Application.Transpose(d.keys)
            .Sort .Cells(1), xlAscending, Header:=xlNo 'tri alphabétique
            ville.Validation.Add xlValidateList, Formula1:="=" & .Address
        End With
    End If
End With
'---tableau des résultats---
If code = "" Or Application.CountIf([Z:Z], ville) = 0 Then ville = ""
xville = ville
If xville <> "" Then
    For i = 2 To UBound(t)
        If t(i, 1) Like xcode And LCase(t(i, 4)) = "oui" And t(i, 5) = xville Then
            n = n + 1
            ReDim Preserve a(1 To 3, 1 To n)
            a(1, n) = t(i, 1)
            a(2, n) = t(i, 3)
            a(3, n) = t(i, 2)
        End If
    Next
End If
If n Then
    With ville(2).Resize(n, 3)
        .Value = Application.Transpose(a)
        .Borders.Weight = xlThin
    End With
End If
Application.EnableEvents = True 'réactive les évènements
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Classeur(2).xlsm
    40.9 KB · Affichages: 10

Jean Jan

XLDnaute Junior
Bonjour job75, et tous....
Merci job75 pour ton exemple cela m'aide énormément ..
Mais je suis pas du tout un expert et j'ai vraiment du mal a adapter le code .:(
Tu crois que cela serait possible de remplir les deux tableaux de mon classeur feuille DET (juste pour 2 localisations) ???
Sachant que la localisation du tableau est en "B1" pour le 1er et "F1" pour le second. l'entête du tableau peut être différente.o_O
Et cela dans une macro pour que tout ce rempli a la fin du traitement de mes données.
Excuse moi d'abuser.:(
Merci d'avance
 

Pièces jointes

  • Classeur(2).xlsm
    31.9 KB · Affichages: 12

job75

XLDnaute Barbatruc
Bonjour Jean Jan,

Voyez ce fichier (3) et le code de la feuille "DET" :
Code:
Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim code$, villes As Range, t, ville As Range, xville$, a(), n&, i&
code = "AA*" 'à adapter, ne pas oublier l'astérisque...
Set villes = [B2,F2] 'adresses des tableaux à adapter
t = Sheets("DEF").[A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
For Each ville In villes
    xville = ville
    Erase a: n = 0 'RAZ
    For i = 2 To UBound(t)
        If t(i, 1) Like code And LCase(t(i, 4)) = "oui" And t(i, 5) = xville Then
            n = n + 1
            ReDim Preserve a(1 To 3, 1 To n)
            a(1, n) = t(i, 1)
            a(2, n) = t(i, 3)
            a(3, n) = t(i, 2)
        End If
    Next i
    ville.CurrentRegion.Offset(1).Clear 'RAZ
    If n Then
        With ville(2).Resize(n, 3)
            .Value = Application.Transpose(a) 'restitution
            .Borders.Weight = xlThin 'bordures
            .Columns(2).NumberFormat = "[h]:mm:ss"
            .Columns(2).HorizontalAlignment = xlCenter
        End With
    End If
Next ville
Application.EnableEvents = True 'réactive les évènements
End Sub
Les tableaux de la feuille "DET" sont mis à jour quand on active la feuille ou qu'on la modifie.

A+
 

Pièces jointes

  • Classeur(3).xlsm
    37.5 KB · Affichages: 18

Jean Jan

XLDnaute Junior
Bonjour Job75 et Bonjour a Tous,
Merci de votre réponse, grâce a vous mon projet a bien avancé.
Mais à votre avis serait-il possible de remplir d’autre tableaux à la suite des deux premiers tableaux.
Ci joint un classeur que j'ai tenté de modifier sans que celui ci fonctionne....:(
Et un grand MERCI de votre Aide…
Jean Jan
 

Pièces jointes

  • Test.xlsm
    31.8 KB · Affichages: 8

Jean Jan

XLDnaute Junior
Bonjour job75,
Encore merci de m’avoir aidé..
Je comprend qu’il soit dangereux de mettre les tableaux les uns en dessous des autres,
mais comment faire pour imprimer les résultats sur une feuilles si les tableaux sont côte à côte ???
Cordialement.
Jean Jan.
 

Jean Jan

XLDnaute Junior
Bonjour job75, bonjour a tous
J'ai suivi votre conseil tous mes tableaux sont alignés horizontalement...
Mais comment faire pour imprimer les résultats sur une feuilles avec des tableaux alignés côte à côte ???
Dans mon exemple 4 tableaux mais dans mon projet au moins 10....;)
Cordialement.
Jean Jan.
 

Pièces jointes

  • Test(2).xlsm
    32.8 KB · Affichages: 6

Discussions similaires

Réponses
3
Affichages
901