Compiler les données de deux feuilles
Bonjour.
J'aurais besoin de compiler les données de deux feuilles vers une troisième feuille avec une disposition particulière. je mets l'exemple du résultat avec l'explication dans le fichier joint.
Merci pour votre aide.
Hassan
Bonjour à tous !
Une approche via Power Query (nativement intégré dans Excel depuis 2016) :
Remarques :
- Deux tableaux structurés ont été insérés (tSource en feuille "Compilation" et tRéf en feuille "Ref echantillon").
- Si la/les sources évoluent, une simple " Actualiser tout " (via le ruban par exemple) retournera un tableau à jour.
- Il est possible d'externaliser les éléments de tSource.
Bonjour
Ma solution en VBA. Le bouton est sur la feuille Pivot en B1...
A+ François
Bonjour à tous !
Une approche via VBA.
nota 1 : à la très ancienne méthode, sans tableau structuré
nota 2 : le tableau est automatiquement mis à jour quand on sélectionne la feuille "Pivot Association"
nota 3 : on peut aussi exécuter directement la macro REOR() ou bien lier cette macro à une forme.
nota 4 : dans le classeur, le code est un tout petit peu commenté
Sub Reor()
Dim derlig&, dercol&, t, tref, i&, j&, n&
Application.ScreenUpdating = False
With Sheets("Compilation")
If .FilterMode Then .ShowAllData
derlig = .Cells(Rows.Count, "a").End(xlUp).Row
dercol = .Cells(4, Columns.Count).End(xlToLeft).Column
Sheets("Pivot Association").Range("e1").CurrentRegion.EntireColumn.Clear
.Range(.Cells(1, "a"), .Cells(derlig, dercol)).Copy Sheets("Pivot Association").Range("a1")
End With
With Sheets("Pivot Association")
.Columns("a:a").Resize(, 3).Insert
.Range("a1").FormulaR1C1 = "=INDEX('Ref echantillon'!R3,MATCH(RC[3],'Ref echantillon'!R3,0))"
.Range("b1").FormulaR1C1 = "=INDEX('Ref echantillon'!R1,MATCH(RC[2],'Ref echantillon'!R3,0))"
.Range("c1").FormulaR1C1 = "=INDEX('Ref echantillon'!R2,MATCH(RC[1],'Ref echantillon'!R3,0))"
.Range("a1:c1").AutoFill Destination:=.Range("a1:c1").Resize(derlig)
.Range("a1:c1").Resize(derlig) = .Range("a1:c1").Resize(derlig).Value
On Error Resume Next
.Columns("a:c").Resize(derlig).SpecialCells(xlCellTypeConstants, 16).FormulaR1C1 = "=R[-1]C"
On Error GoTo 0
.Columns("a:c").Resize(derlig) = .Columns("a:c").Resize(derlig).Value
dercol = dercol + 3
t = .Range("a1").Resize(derlig, dercol)
n = 1
For i = 2 To derlig
If t(i, 1) <> t(i, 4) Then: n = n + 1: For j = 1 To dercol: t(n, j) = t(i, j): Next
Next i
t(1, 1) = "Ref GeMMe": t(1, 2) = "Flux": t(1, 3) = "Nom échantillon": t(1, 4) = "Minéral"
.Range("a1").Resize(derlig, dercol).Clear
.Range("a1").Resize(n, dercol) = t
.Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous
.Range("a1").CurrentRegion.EntireColumn.AutoFit
For i = 2 To UBound(t)
If t(i, 1) <> t(i - 1, 1) Then
.Rows(i).Resize(, dercol).Borders(xlEdgeTop).Color = RGB(0, 0, 255)
.Rows(i).Resize(, dercol).Borders(xlEdgeTop).Weight = xlMedium
End If
Next i
Application.Goto .Range("a1"), True
End With
End SubBonsoir le forum,
Una autre façon de procéder :
Option Explicit
Sub Retraitement()
Dim a, b, c, pos, i As Long, ii As Long, j As Long, n As Long, col As Long
Dim refGeMMe, EnTete, cell As Range, currentValue As String, previousValue As String
a = Sheets("Compilation").Range("A1").CurrentRegion.Value
c = Sheets("Ref echantillon").Range("A1").CurrentRegion.Value
EnTete = [{"Ref GeMMe","Flux","Echantillon","Minéral"}]
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2) + 3)
For i = 1 To UBound(a, 1)
ii = 0
Do While IsEmpty(a(i + ii, 2)) Or IsNumeric(a(i + ii, 2))
If ii = 0 Then
refGeMMe = a(i - 1 + ii, 1)
pos = Application.Match(refGeMMe, Application.Index(c, 3, 0), 0)
End If
b(n + 1, 1) = refGeMMe ' Ref GeMMe
b(n + 1, 2) = c(1, pos) ' Flux
b(n + 1, 3) = c(2, pos) ' Nom Echantillon
For j = 1 To UBound(a, 2)
b(n + 1, j + 3) = a(i + ii, j)
Next
ii = ii + 1: n = n + 1
' Sort de la boucle si fin de ligne
If i + ii > UBound(a, 1) Then Exit Do
Loop
If ii > 0 Then
i = i + ii - 1
End If
Next
' Restitution
Application.ScreenUpdating = False
If Not Evaluate("isref('Retraitement'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Retraitement"
With Sheets("Retraitement")
With .Cells(1)
.CurrentRegion.Clear
If n > 0 Then
.Offset(, 3).Resize(, UBound(a, 2)).Value = Application.Index(a, 1, 0)
.Resize(, 4).Value = EnTete
.Offset(1).Resize(n, UBound(b, 2)).Value = b
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Rows(1)
.HorizontalAlignment = xlCenter
.Font.Size = 11
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 44
End With
' Appliquer le format nombre avec 2 décimales à partir de la colonne 5
For col = 5 To .Columns.Count
.Columns(col).NumberFormat = "0.00"
Next col
.Columns.AutoFit
previousValue = .Cells(2, 1).Value
' Boucle à travers les lignes à partir de la deuxième
For Each cell In .Offset(1).Resize(.Rows.Count - 1, 1)
currentValue = cell.Value
' Vérifier si la valeur change par rapport à la précédente
If currentValue <> previousValue Then
' Ajouter une bordure en bas de la ligne précédente
cell.Offset(-1).EntireRow.Borders(xlEdgeBottom).LineStyle = xlContinuous
cell.Offset(-1).EntireRow.Borders(xlEdgeBottom).Weight = xlThin
End If
' Mettre à jour la valeur précédente
previousValue = currentValue
Next
End With
End If
End With
End With
Application.ScreenUpdating = True
End Subklin89
Bonjour à vous tous qui ont répondu à ma requête et désolé pour le retard dans ma réponse.
Je tiens à vous remercier tous les 4 pour votre aide. les 4 solutions fonctionnent et répondent à mon attente. C'est vraiment génial et ça m'aide énormément. Pour votre information, je suis chercheur à l'Université de Liège et c'est une tâche qui me prends énormément de temps. Parfois j'ai plusieurs échantillons à traiter avec nos chercheurs et étudiants (des dizaines parfois). Votre code me fera gagner un temps vraiment précieux. si vous me permettez, je vais juste vous donner mon retour sur les 4 propositions:
- JFL : elle n'a pas bien fonctionné sur un autre jeux de données. quand j'ai ajouté une 5eme et 6ème données, il a reproduit les mêmes données que la quatrième
- Klin89 : ça fonctionne bien, le code fait le travail, mais il ne copie pas la liste des minéraux qui se trouve sur la même ligne que la référence G100. Ce n'est pas si grave, un juste copie/coller et on y est :-)
- mafraise et Fanfan38 fonctionnent aussi très bien et font tout le travail attendu
Je ne vous cache pas que j'ai une préférence pour la proposition de mafraise qui gagne un million de $.
Cool les gars, vous êtes très sympathiques et je vous en remercie ENORMEMENT..
@mafraise : Comme je vais adopter ton code, est ce que je peux te demander une autre service svp. Comme le nom le dit, la feuille "compilation" est une compilation de 4 feuilles dans l'exemple que j'ai donné. Ces données sont générées par un logiciel d'un microscope électronique et selon les projets, je peux avoir jusqu'à 50 échantillons, même plus. les résultats sont générés dans un fichier Excel qui contient autant de feuille que d'échantillons et qu'il faut complier dans une seule feuille pour les formater au format Pivot (ce que vous avez fait). Est ce possible que je vous donne un exemple de fichier avec les différentes feuilles sources qu'il faut compiler dans une seule feuille puis envoyer vers la feuille "Pivot" ?
(j'ai un code VBA qui compile les données vers une seule feuille et qui a été fait il y'a quelques années ici sur le forum, je peux le fournir. J'aimerai avoir une solution complète, dans un seul fichier et qui évite de multiples manipulation car ça me fera gagner beaucoup de temps et surtout faire moins d'erreur de manipulation)
Merci pour votre précieuse aide :-)
Hassan
Bonjour à tous !
- JFL : elle n'a pas bien fonctionné sur un autre jeux de données. quand j'ai ajouté une 5eme et 6ème données, il a reproduit les mêmes données que la quatrième
Mais encore ?
Quelles sont les données nouvelles ?
Auriez-vous un jeu de données à communiquer ?
Remarque : C'est uniquement pour ma gouverne puisque votre choix est autre.
Si c'est chronophage dites le simplement.
Bonjour à tous
senlis01 a demandé :
Est ce possible que je vous donne un exemple de fichier avec les différentes feuilles sources qu'il faut compiler dans une seule feuille puis envoyer vers la feuille "Pivot" ?
(j'ai un code VBA qui compile les données vers une seule feuille et qui a été fait il y'a quelques années ici sur le forum, je peux le fournir. J'aimerai avoir une solution complète, dans un seul fichier et qui évite de multiples manipulation car ça me fera gagner beaucoup de temps et surtout faire moins d'erreur de manipulation)
Fournissez nous les fichiers et on le fera (du moins, on essaiera).
Quand on rajoute un souhait, il ne faut exclure aucun répondeur. C'est juste un point pratique. Quelquefois la demande supplémentaire est beaucoup plus simple à réaliser avec une des méthodes non retenues qu'avec la solution choisie de prime abord . En plus, de nouvelles données plus conformes à la réalité permettront aux demandeurs des solutions "bancales" de reprendre leur travail (avec en plus l'intégration du souhait en bonus). En tant que répondeur, même si ma solution n'est pas retenue, j'aime bien malgré tout la faire fonctionner correctement
Bonjour,
Merci pour vos réponses et je suis désolé si je me suis mal exprimé en disant que la solution de mafraise était celle que j'adopterai. Je suis sincèrement désolé et merci encore pour votre précieuse aide.
Merci aussi d'avoir accepté de voir ma demande dans son intégralité. Je vous joint mon fichier avec la code qui compile les données des différentes feuilles (en rouge) des données brutes.
Merci
Hassan
Bonjour à tous de nouveau !
Dans le jeu de données originel, la référence GeMMe était indiquée sur 4 positions.
Dans le second jeu de données, cette référence est sur 5 positions. La requête adaptée semble retourner le résultat attendu.
Re senlis01 🙂
Si toutes les données des feuilles Gxxx sont structurées de la même façon, même nombre et ordre de colonnes, pas besoin de passer par l'intermédiaire de la feuille "Compilation" pour obtenir le résultat escompté dans la feuille "Pivot Association"
C'est même beaucoup plus simple.
Édit 🥴 pas vu qu'il n'y avait pas les mêmes en-têtes et nombre de colonnes sur chaque feuille Gxxx
klin89
Re,
1) Klin89 que je salue a posé la bonne question. La feuille "Compilation" est-elle nécessaire ? Si oui alors sous quelle présentation ?
2) D'autre part, dans le fichier joint, il y a des rubriques de colonnes qui sont sur les feuilles "Compilation" mais qui sont absentes de toutes les feuilles "G9999" ???
D'où viennent ces colonnes ? En exemple la colonne "Plagioclase".
Bonjour à tous de nouveau.
Merci infiniment pour vos réactions, vous êtes des passionnés les gars
Pour répondre à vos questions, je remets mon fichier au complet avec les données et ce que je souhaiterais avoir comme traitement, si vous le voulez bien ;-)
J'ai besoin que les données dans les différentes feuilles Gxxxx soient transférées dans un premier temps vers la feuille compilation. Cette feuille sert à synthétiser toutes les données dans une seule feuille pour partager avec le chercheur concerné. La feuille pivot servira à faire un tableau et un graphique croisé dynamique pour comparaison des données car on peut se retrouver sur une infinité de données qu'il est très difficile de lire et surtout comparer dans un tableau.
Merci pour votre aide les gars. qu'est-ce que j'aurais aimé avoir vos habilités avec Excel, mais j'ai un doctorat qui me permet de parler avec des minéraux ;-)
Belle journée à tous.
Hassan
Re à tous,
J'en suis resté à ma remarque du samedi 22 février à 14h21
Je parcours les feuilles concernées, c'est plus simple.
Option Explicit
Sub Consolidation()
Dim a, b, c, e, pos, i As Long, j As Long, n As Long, col As Long
Dim dico As Object, feuilles, ws As Worksheet
Dim cell As Range, currentValue As String, previousValue As String
' Création du dictionnaire pour les en-têtes
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
c = Sheets("Ref echantillon").Range("A1").CurrentRegion.Value
feuilles = Application.Index(c, 3, Evaluate("ROW(2:" & UBound(c, 2) & ")"))
' Déterminer tous les en-têtes distincts
For Each e In feuilles
Set ws = Sheets(e)
a = ws.Range("A1").CurrentRegion.Value
' indexation des en-têtes via le dictionnaire
For j = 2 To UBound(a, 2)
If Not dico.exists(a(1, j)) Then
dico(a(1, j)) = dico.Count + 5
End If
Next
Next
ReDim b(1 To 1000, 1 To dico.Count + 4)
' Remplir les en-têtes dans `b`
b(1, 1) = "Ref GeMMe": b(1, 2) = "Flux"
b(1, 3) = "Nom Echantillon": b(1, 4) = "Mineral"
For Each e In dico.keys
b(1, dico(e)) = e
Next
' Remplir les données
n = 1 ' Ligne de remplissage
For Each e In feuilles
Set ws = Sheets(e)
pos = Application.Match(e, Application.Index(c, 3, 0), 0)
a = ws.Range("A1").CurrentRegion.Value
For i = 2 To UBound(a, 1)
n = n + 1
b(n, 1) = e ' Ref GeMMe
b(n, 2) = c(1, pos) ' Flux
b(n, 3) = c(2, pos) ' Nom Echantillon
b(n, 4) = a(i, 1) ' Minéral
' Associer les données à la bonne colonne
For j = 2 To UBound(a, 2)
If dico.exists(a(1, j)) Then
b(n, dico(a(1, j))) = a(i, j)
End If
Next
Next
Next
' Restitution et mise en forme
Application.ScreenUpdating = False
If Not Evaluate("isref('Consolidation'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Consolidation"
With Sheets("Consolidation")
With .Cells(1)
.CurrentRegion.Clear
If n > 0 Then
.Resize(n, UBound(b, 2)).Value = b
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Rows(1)
.HorizontalAlignment = xlCenter
.Font.Size = 11
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 44
End With
' Appliquer le format nombre avec 2 décimales à partir de la colonne 5
For col = 5 To .Columns.Count
.Columns(col).NumberFormat = "0.00"
Next col
.Columns.AutoFit
previousValue = .Cells(2, 1).Value
' Boucle à travers les lignes à partir de la deuxième
For Each cell In .Offset(1).Resize(.Rows.Count - 1, 1)
currentValue = cell.Value
' Vérifier si la valeur change par rapport à la précédente
If currentValue <> previousValue Then
' Ajouter une bordure en bas de la ligne précédente
cell.Offset(-1).EntireRow.Borders(xlEdgeBottom).LineStyle = xlContinuous
cell.Offset(-1).EntireRow.Borders(xlEdgeBottom).Weight = xlThin
End If
' Mettre à jour la valeur précédente
previousValue = currentValue
Next
End With
End If
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
MsgBox "Données rassemblées avec succès !", vbInformation
End Subklin89
Re à tous,
Plus simple comme ça:
Option Explicit
Sub Consolidation2()
Dim a, b, c, e, pos, i As Long, j As Long, n As Long, col As Long
Dim dico As Object, feuilles, ws As Worksheet
Dim cell As Range, currentValue As String, previousValue As String
' Création du dictionnaire pour stocker les en-têtes distincts
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
' Récupération des feuilles concernées
c = Sheets("Ref echantillon").Range("A1").CurrentRegion.Value
feuilles = Application.Index(c, 3, Evaluate("ROW(2:" & UBound(c, 2) & ")"))
' Déclaration du tableau de sortie
ReDim b(1 To 1000, 1 To 4) ' Initialisé avec 4 colonnes fixes
' Initialisation des en-têtes fixes
b(1, 1) = "Ref GeMMe": b(1, 2) = "Flux"
b(1, 3) = "Nom Echantillon": b(1, 4) = "Mineral"
' Remplir les données et récupérer les en-têtes au fur et à mesure
n = 1 ' Compteur de ligne dans `b`
For Each e In feuilles
Set ws = Sheets(e)
pos = Application.Match(e, Application.Index(c, 3, 0), 0)
a = ws.Range("A1").CurrentRegion.Value
' Parcours des lignes de données
For i = 2 To UBound(a, 1)
n = n + 1
' Remplir les 4 premières colonnes fixes
b(n, 1) = e ' Ref GeMMe
b(n, 2) = c(1, pos) ' Flux
b(n, 3) = c(2, pos) ' Nom Echantillon
b(n, 4) = a(i, 1) ' Minéral
' Ajout des autres colonnes dynamiquement
For j = 2 To UBound(a, 2)
If Not dico.exists(a(1, j)) Then
dico(a(1, j)) = UBound(b, 2) + 1 ' Nouvelle colonne
ReDim Preserve b(1 To 1000, 1 To UBound(b, 2) + 1)
b(1, UBound(b, 2)) = a(1, j) ' Ajout de l'en-tête
End If
' Remplissage des valeurs
b(n, dico(a(1, j))) = a(i, j)
Next
Next
Next
' Restitution et mise en forme
Application.ScreenUpdating = False
If Not Evaluate("isref('Consolidation'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Consolidation"
With Sheets("Consolidation")
With .Cells(1)
.CurrentRegion.Clear
If n > 0 Then
.Resize(n, UBound(b, 2)).Value = b
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Rows(1)
.HorizontalAlignment = xlCenter
.Font.Size = 11
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 44
End With
' Appliquer le format nombre avec 2 décimales à partir de la colonne 5
For col = 5 To .Columns.Count
.Columns(col).NumberFormat = "0.00"
Next col
.Columns.AutoFit
previousValue = .Cells(2, 1).Value
' Boucle à travers les lignes à partir de la deuxième
For Each cell In .Offset(1).Resize(.Rows.Count - 1, 1)
currentValue = cell.Value
' Vérifier si la valeur change par rapport à la précédente
If currentValue <> previousValue Then
' Ajouter une bordure en bas de la ligne précédente
cell.Offset(-1).EntireRow.Borders(xlEdgeBottom).LineStyle = xlContinuous
cell.Offset(-1).EntireRow.Borders(xlEdgeBottom).Weight = xlThin
End If
' Mettre à jour la valeur précédente
previousValue = currentValue
Next
End With
End If
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
MsgBox "Données rassemblées avec succès !", vbInformation
End Subklin89
Merci Klin89 pour cette proposition,
Je vais la tester demain à l'Université avec un autre jeux de données de plusieurs feuilles et données plus importantes. Je te donnerai des nouvelles demain.
Très belle fin de soirée.
Hassan
Re senlis 01,
Pour répondre au post de 13h38 :
Option Explicit
Sub Compilation()
Dim a, c, e, i As Long, j As Long, n As Long, col As Long
Dim dico As Object, Al1 As Object, Al2 As Object
Dim tbl(), ws As Worksheet, feuilles
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
Set Al1 = CreateObject("System.Collections.ArrayList")
Set Al2 = CreateObject("System.Collections.ArrayList")
c = Sheets("Ref echantillon").Range("A1").CurrentRegion.Value
feuilles = Application.Index(c, 3, Evaluate("ROW(2:" & UBound(c, 2) & ")"))
For Each e In feuilles
Set ws = Nothing
On Error Resume Next
Set ws = Sheets(e)
On Error GoTo 0
If Not ws Is Nothing Then
a = ws.Range("A1").CurrentRegion.Value
For j = 2 To UBound(a, 2) - 1 ' On parcourt les en-tetes
If Not Al1.Contains(a(1, j)) Then
Al1.Add a(1, j)
End If
Next
For i = 2 To UBound(a, 1) ' On parcourt la 1ère colonne
If Not Al2.Contains(a(i, 1)) Then
Al2.Add a(i, 1)
End If
Next
End If
Next
Al1.Sort: Al2.Sort: Al1.Add "Background"
For Each e In feuilles
Set ws = Nothing
On Error Resume Next
Set ws = Sheets(e)
On Error GoTo 0
If Not ws Is Nothing Then
a = ws.Range("A1").CurrentRegion.Value
ReDim tbl(1 To Al2.Count + 1, 1 To Al1.Count + 1)
tbl(1, 1) = e
For i = 0 To Al1.Count - 1
tbl(1, i + 2) = Al1(i)
Next
For j = 0 To Al2.Count - 1
tbl(j + 2, 1) = Al2(j)
Next
For i = 2 To UBound(a, 1)
For j = 2 To UBound(a, 2)
tbl(Al2.IndexOf(a(i, 1), 0) + 2, Al1.IndexOf(a(1, j), 0) + 2) = a(i, j)
Next
Next
dico(e) = tbl
End If
Next
Application.ScreenUpdating = False
If Not Evaluate("isref('Compilation1'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Compilation1"
With Sheets("Compilation1")
n = 1
.Cells(n).CurrentRegion.Clear
For Each e In dico.keys
With .Cells(n, 1).Resize(UBound(dico.Item(e), 1), UBound(dico.Item(e), 2))
.Value = dico.Item(e)
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Cells(1).Font.Bold = True
.Cells(.Rows(1).Cells.Count).Interior.ColorIndex = 44
With .Rows(1)
.Borders(xlEdgeBottom).Weight = xlThin
.HorizontalAlignment = xlCenter
With .Offset(, 1).Resize(, .Columns.Count - 2)
.Interior.ColorIndex = 42
End With
End With
With .Columns(1)
With .Offset(1).Resize(.Rows.Count - 1)
.Interior.ColorIndex = 19
End With
End With
End With
n = n + UBound(dico.Item(e), 1)
Next
With .Cells(1).CurrentRegion
.VerticalAlignment = xlCenter
.Font.Name = "Calibri"
.Font.Size = 10
For col = 2 To .Columns.Count
.Columns(col).NumberFormat = "0.00"
Next col
.Columns.AutoFit
End With
End With
Set dico = Nothing: Set Al1 = Nothing: Set Al2 = Nothing
Application.ScreenUpdating = True
MsgBox "Données rassemblées avec succès !", vbInformation
End Subklin89
Merci Klin89 pour cette dernière proposition que je n'ai pas pu m'empêcher de tester ;-). Le code retourne une erreur à la ligne 7 : Set Al1 = CreateObject("System.Collections.ArrayList")
Merci pour ta précieuse aide.
Hassan
Re senlis01
Je reprends les propos de thev parce que je n'ai pas d'erreurs chez moi :
Le ..NetFramework est une panoplie d'outils contenant entre autres des bibliothèques de classe.
La classe "system.collections.arraylist" fait partie d'une bibliothèque de classe se trouvant dans .NetFramework 3.5 qui n'est plus installé en standard depuis Windows 10. Il a été remplacé par le .NetFramework 4.8 qui ne reprend pas les fonctionnalités du .NetFramework 3.5
Si donc, vous voulez bénéficier des anciennes fonctionnalités du .NetFramework 3.5 (arraylist), vous devez l'installer.
Pour cela sous Windows 11: Paramètres --> Applications --> Plus de fonctionnalités Windows --> Activer ou désactiver des fonctionnalités Windows
Après installation, vous n'avez pas pas besoin de la référence de la bibliothèque correspondante, puisque vous faites dans votre procédure, une liaison tardive (Late Binding) via un CreateObject.
klin89
Bonjour à tous
La version v2 de ma pomme.
Elle n'utilise aucune structure objet rien que des tableaux et une feuille de manœuvre.
Dans la feuille "Menu", cliquez sur un des trois boutons.
Le code est dans Module1.
...
nota : La feuille de manœuvre (appelée BdD) est supprimée à la fin des procédures de mise à jour. Si vous désirez savoir ce qu'elle contient, exécutez directement la procédure MajBdD() dans Module1. Si on le désirait, les données qu'elle contient pourraient être facilement transformées en tableaux structurés qui seraient directement utilisables dans Power Query (par ses adeptes).