>_Prompt utilisé : Donne moi un code VBA pour Excel qui permet de créer dans le classeur actuel une nouvelle feuille nommée "Métriques" contenant une table de données de 10000 lignes contenant des données fictives avec une colonne nommée "Date" au format date courte contenant des dates aléatoires avec doublons de 2020 à 2023, classées par ordre croissant, une colonne nommée "IdRéseau" contenant des chiffres aléatoires avec doublons de 1 à 10, une colonne nommée "IdPays" contenant des chiffres aléatoires avec doublons de 1 à 10, et enfin une colonne nommée "Minutes" contenant des chiffres aléatoires avec doublons de 1 à 300 mais reflétant la réalité des fréquentations actuelles des 10 réseaux sociaux les plus visités. Puis dans une nouvelle feuille nommée "Réseaux" du même classeur une table de données contenant la liste des 10 principaux réseaux sociaux avec une Colonne nommée "IdRéseau" contenant les chiffres de 1 à 10 classés par ordre croissant sans doublon et une colonne nommée "NomRéseau" sans doublon contenant les noms des 10 principaux réseaux sociaux utilisés dans le monde. Enfin, dans une nouvelle feuille nommée "Pays" du même classeur une table de données contenant la liste des pays avec une Colonne nommée "IdPays" contenant les chiffres de 1 à 10 classés par ordre croissant sans doublon, une colonne nommée "NomPays" sans doublon contenant les noms des 10 pays les plus connectés à Internet.
>_IA interrogée :ChatGPT 4.o
Voici le code VBA qui répond à vos spécifications :
Sub CreerFeuillesMetriquesAvecPonderation()
' Déclaration des variables
Dim wsMetriques As Worksheet
Dim wsReseaux As Worksheet
Dim wsPays As Worksheet
Dim tblMetriques As ListObject
Dim tblReseaux As ListObject
Dim tblPays As ListObject
Dim i As Long
Dim dateDebut As Date
Dim idReseau As Variant
Dim idPays As Variant
Dim ponderationMinutes As Variant
Dim idReseauValeur As Integer
Dim minMinutes As Integer, maxMinutes As Integer
' Supprimer les feuilles existantes si elles sont déjà présentes
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Métriques").Delete
Worksheets("Réseaux").Delete
Worksheets("Pays").Delete
Application.DisplayAlerts = True
On Error GoTo 0
' Création des nouvelles feuilles
Set wsMetriques = Worksheets.Add
wsMetriques.Name = "Métriques"
Set wsReseaux = Worksheets.Add
wsReseaux.Name = "Réseaux"
Set wsPays = Worksheets.Add
wsPays.Name = "Pays"
' Génération de la feuille "Métriques"
wsMetriques.Range("A1").Value = "Date"
wsMetriques.Range("B1").Value = "IdRéseau"
wsMetriques.Range("C1").Value = "IdPays"
wsMetriques.Range("D1").Value = "Minutes"
dateDebut = DateSerial(2020, 1, 1)
' Définir la pondération pour les temps de connexion (basé sur popularité actuelle)
' L'ordre correspond à l'ordre des réseaux sociaux dans la colonne IdRéseau
ponderationMinutes = Array(180, 150, 140, 120, 110, 100, 90, 80, 70, 60) ' Minutes maximales pour chaque réseau
For i = 2 To 10001
' Génération de dates aléatoires entre 2020 et 2023
wsMetriques.Cells(i, 1).Value = DateSerial(2020, 1, 1) + Int(Rnd() * 1461)
' Génération d'IdRéseau aléatoires entre 1 et 10
idReseauValeur = Int((10 - 1 + 1) * Rnd + 1)
wsMetriques.Cells(i, 2).Value = idReseauValeur
' Génération d'IdPays aléatoires entre 1 et 10
wsMetriques.Cells(i, 3).Value = Int((10 - 1 + 1) * Rnd + 1)
' Génération du nombre de minutes en fonction de la pondération du réseau
minMinutes = 10 ' Minutes minimales pour tout réseau
maxMinutes = ponderationMinutes(idReseauValeur - 1)
wsMetriques.Cells(i, 4).Value = Int((maxMinutes - minMinutes + 1) * Rnd + minMinutes)
Next i
' Tri des dates dans l'ordre croissant
wsMetriques.Sort.SortFields.Clear
wsMetriques.Sort.SortFields.Add Key:=Range("A2:A10001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wsMetriques.Sort
.SetRange Range("A1:D10001")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Mise sous forme de tableau dans la feuille "Métriques"
Set tblMetriques = wsMetriques.ListObjects.Add(xlSrcRange, wsMetriques.Range("A1:D10001"), , xlYes)
tblMetriques.Name = "Métriques"
' Génération de la feuille "Réseaux"
wsReseaux.Range("A1").Value = "IdRéseau"
wsReseaux.Range("B1").Value = "NomRéseau"
' Définir le tableau de réseaux sociaux
idReseau = Array("Facebook", "YouTube", "WhatsApp", "Instagram", "TikTok", "Snapchat", "Twitter", "LinkedIn", "Pinterest", "Reddit")
For i = 1 To 10
wsReseaux.Cells(i + 1, 1).Value = i
wsReseaux.Cells(i + 1, 2).Value = idReseau(i - 1)
Next i
' Mise sous forme de tableau dans la feuille "Réseaux"
Set tblReseaux = wsReseaux.ListObjects.Add(xlSrcRange, wsReseaux.Range("A1:B11"), , xlYes)
tblReseaux.Name = "Réseaux"
' Génération de la feuille "Pays"
wsPays.Range("A1").Value = "IdPays"
wsPays.Range("B1").Value = "NomPays"
' Définir le tableau de pays
idPays = Array("États-Unis", "Chine", "Inde", "Japon", "Allemagne", "Royaume-Uni", "France", "Brésil", "Russie", "Mexique")
For i = 1 To 10
wsPays.Cells(i + 1, 1).Value = i
wsPays.Cells(i + 1, 2).Value = idPays(i - 1)
Next i
' Mise sous forme de tableau dans la feuille "Pays"
Set tblPays = wsPays.ListObjects.Add(xlSrcRange, wsPays.Range("A1:B11"), , xlYes)
tblPays.Name = "Pays"
MsgBox "Les feuilles 'Métriques', 'Réseaux' et 'Pays' ont été créées avec succès avec une pondération des minutes !"
End SubCe code crée les feuilles “Métriques”, “Réseaux” et “Pays” avec les données spécifiées. N’hésitez pas à ajuster selon vos besoins.
Voir la suite avec Analyse de Tables avec ChatGPT.