XL 2013 VBA - Croiser des données

[Arnaud81]

Bonjour,

J'ai un tableau dans la feuille source avec en colonne A et B une liste de fonctions et la description et dans les autres colonnes les sites associés

Afin de pouvoir traiter ces données, je souhaiterai avoir une macro qui balaye la liste des fonctions : si un site est trouvé pour une fonction, alors la macro copie le nom et la description de la fonction dans la feuille cible et ajoute en colonne C le nom du site (Exemple décrit dans la feuille cible)

Une idée ? J'ai dans la réalité environ 200 sites et plus de 8000 fonctions...

Merci d'avance

 

[Dranreb]

Bonjour.
Ceci vous irait-il ?

Option Explicit

Sub test()
Dim TE(), TS(), LE&, LS&, C
TE = Feuil22.[A3:K3].Resize(Feuil22.[A1000000].End(xlUp).Row - 2).Value
ReDim TS(1 To UBound(TE, 1) * (UBound(TE, 2) - 2), 1 To 3)
For LE = 1 To UBound(TE, 1)
   For C = 3 To UBound(TE, 2)
      If TE(LE, C) <> "" Then
         LS = LS + 1
         TS(LS, 1) = TE(LE, 1)
         TS(LS, 2) = TE(LE, 2)
         TS(LS, 3) = TE(LE, C)
         End If: Next C, LE
Feuil23.[A2:C1000000].ClearContents
Feuil23.[A2:C2].Resize(LS).Value = TS
End Sub

 

[Arnaud81]

Cela fonctionne très bien. Merci.

Pour que je comprenne mieux, a quoi correspondent les différentes variables TE TS, ... ? Correspondent ils à chaque site ou cela n'a rien à voir ?

Par ailleurs, si au lieu d'avoir dans chaque cellule le nom du site, j'ai juste "x", la macro peut elle aller chercher le nom du site en haut de colonne ?

 

[Dranreb]

Les variables déclarée avec () sont des tableaux VBA dynamiques en mémoire. Dynamiques parce que leurs dimensions ne sont pas fixées à la déclaration mais lors de l'exécution, soit en leur affectant une expression tableau telle que la propriété Value d'un Range de plusieurs cellules contigües, soit par une instruction Redim. (Mes noms: T pour tableau, L pour ligne, C pour colonne, E pour entrée, S pour sortie. Et maintenant Tit pour titres)

Pour chercher le nom du site dans les titres:

Sub test()
Dim TTit(), TE(), TS(), LE&, LS&, C
TTit = Feuil22.[A2:K2].Value
TE = Feuil22.[A3:K3].Resize(Feuil22.[A1000000].End(xlUp).Row - 2).Value
ReDim TS(1 To UBound(TE, 1) * (UBound(TE, 2) - 2), 1 To 3)
For LE = 1 To UBound(TE, 1)
   For C = 3 To UBound(TE, 2)
      If TE(LE, C) <> "" Then
         LS = LS + 1
         TS(LS, 1) = TE(LE, 1)
         TS(LS, 2) = TE(LE, 2)
         TS(LS, 3) = TTit(1, C)
         End If: Next C, LE
Feuil23.[A2:C1000000].ClearContents
Feuil23.[A2:C2].Resize(LS).Value = TS
End Sub

 

[Arnaud81]

C'est top. Merci beaucoup.

Si je peux abuser pour la suite...

A partir de la liste ainsi constituée, j'ai une macro qui me crée un onglet par site et qui fonctionne nikel. (dans l'exemple joint j'ai l'onglet "ALL-RCPT")

J'ai un onglet supplémentaire avec la liste de fonctions V6 et sa ou ses correspondances en V7 (exemple Fonction A V6 = Fonction A1 V7 ou bien Fonction B V6 = Fonction B1 et Fonction B2 V7)

J'aimerais qu'une macro puisse aller compter dans l'onglet versions, le nombre d'occurence V7 associées à la fonction V6 et aille noter ce nombre dans l'onglet ALL-RCPT (colonne C)

Merci d'avance

 

[pierrejean]

Bonjour Arnaud81

Un essai

Arf :A la bourre moi
Salut Bernard

 

[Dranreb]

Je ne ne me vois pas réinventer la poudre alors que j'ai des utilitaires qui savent organiser, inventorier et compter dans ce complément.
Mais je vais (peut être) écrire une procédure qui l'utilise…

Bonjour pierrejean.

 

[Arnaud81]

Merci Pierre Jean et Dranreb.

Dranreb, je vais essayer de voir ce que je peux faire avec ton fichier mais comme je n'y connais vraiment pas grand chose en VBA si ce n'est pour adpater une macro en fonction des colonnes ou des lignes, je ne sais pas si je vais aller bien loin...

 

[Dranreb]

La voici ma procédure :

Sub test()
Dim TTit(), TE(), TS(), LE&, LS&, C, IdFunc As SsGr, DCount As New Dictionary, Site As SsGr, F As Long, Wsh As Worksheet
TTit = Feuil22.[A2:K2].Value
TE = Feuil22.[A3:K3].Resize(Feuil22.[A1000000].End(xlUp).Row - 2).Value
ReDim TS(1 To UBound(TE, 1) * (UBound(TE, 2) - 2), 1 To 3)
For LE = 1 To UBound(TE, 1)
   For C = 3 To UBound(TE, 2)
      If TE(LE, C) <> "" Then
         LS = LS + 1
         TS(LS, 1) = TE(LE, 1)
         TS(LS, 2) = TE(LE, 2)
         TS(LS, 3) = TTit(1, C)
         End If: Next C, LE
Feuil23.[A2:C1000000].ClearContents
Feuil23.[A2:C2].Resize(LS).Value = TS
For Each IdFunc In Gigogne(Feuil24.[A2], 1)
   DCount(IdFunc.Id) = IdFunc.Count: Next IdFunc
For F = 4 To ThisWorkbook.Worksheets.Count
   Set Wsh = ThisWorkbook.Worksheets(F)
   Wsh.Name = Wsh.CodeName: Next F
F = 3
GigIdx.DernièreLigneÀIndexer = LS
For Each Site In Gigogne(TS, 3, 1)
   ReDim TS(1 To Site.Count, 1 To 3)
   LS = 0
   For Each IdFunc In Site.Co
      LS = LS + 1
      TS(LS, 1) = IdFunc.Id
      TS(LS, 2) = IdFunc.Co(1)(2)
      TS(LS, 3) = DCount(IdFunc.Id)
      Next IdFunc
   If F >= ThisWorkbook.Worksheets.Count Then ThisWorkbook.Worksheets(F).Copy _
      After:=ThisWorkbook.Worksheets(F)
   F = F + 1: Set Wsh = ThisWorkbook.Worksheets(F)
   Wsh.Name = Site.Id
   Wsh.[A2:C1000000].ClearContents
   Wsh.[A2:C2].Resize(LS).Value = TS
   Next Site
F = F + 1
Application.DisplayAlerts = False
While F <= ThisWorkbook.Worksheets.Count
  ThisWorkbook.Worksheets(F).Delete: Wend
Application.DisplayAlerts = True
End Sub

N'oubliez pas de cocher la référence à GigIdx après son installation, ainsi que la référence à Microsoft Scripting Runtime