XL 2016 Plantage au niveau Excel 2016

yaraar

XLDnaute Junior
Bonjour;

y'a t'il une astuce pour éviter le plantage réplétif sur mon Fichier excel , je travail sur un fichier excel avec plus de 100,000 lignes et 30 colonnes.
 
Solution
Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G1]) Is Nothing Then Exit Sub
Dim dat, dest As Range, d As Object, dd As Object, tablo, i&, x$, titre, ncol%, j%, a
dat = [G1]
Set dest = [G4] '1ère cellule de destination
'---tableau source---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = [Tableau2] 'tableau structuré
For i = 1 To UBound(tablo)
    d(tablo(i, 2)) = ""
    x = tablo(i, 2) & tablo(i, 4) & tablo(i, 3) & tablo(i, 1)
    If Not dd.exists(x) Then dd(x) = tablo(i, 5)
Next i
If d.Count = 0 Then GoTo 1
'---tableau des titres---
titre = [G2:AE3] 'à adapter
ncol = UBound(titre, 2)
For j = 2 To...

JHA

XLDnaute Barbatruc
Bonjour à tous,

Si il s'agit de ce fichier, un début de solution, données en mode tableau, pas de vide dans ce tableau
Mettre une liste déroulante des références "eNodeB".

JHA
 

Pièces jointes

  • Classeur.xlsx
    158.4 KB · Affichages: 13

job75

XLDnaute Barbatruc
Le tableau présenté par JHA correspond à celui utilisé par yaraar dans son fil précédent.

1) Il y a une erreur dans les formules : en L4 P4 T4... remplacer $H$2 par $L$2 $P$2 $T$2...

2) Les formules sont matricielles, ce qui prend du temps c'est cette concaténation dans chaque cellule :
Code:
Tableau2[eNodeB]&Tableau2[Procedure Type]&Tableau2[Mesures]&Tableau2[Day]
Pour y remédier on peut utiliser une macro VBA qui calculera cette expression une seule fois.
 

job75

XLDnaute Barbatruc
Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G1]) Is Nothing Then Exit Sub
Dim dat, dest As Range, d As Object, dd As Object, tablo, i&, x$, titre, ncol%, j%, a
dat = [G1]
Set dest = [G4] '1ère cellule de destination
'---tableau source---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = [Tableau2] 'tableau structuré
For i = 1 To UBound(tablo)
    d(tablo(i, 2)) = ""
    x = tablo(i, 2) & tablo(i, 4) & tablo(i, 3) & tablo(i, 1)
    If Not dd.exists(x) Then dd(x) = tablo(i, 5)
Next i
If d.Count = 0 Then GoTo 1
'---tableau des titres---
titre = [G2:AE3] 'à adapter
ncol = UBound(titre, 2)
For j = 2 To ncol
    If titre(1, j) = "" Then titre(1, j) = titre(1, j - 1) 'remplit les cellules vides
Next j
'---tableau des résultats---
tablo = dest.Resize(d.Count, ncol)
a = d.keys
For i = 0 To UBound(a)
    tablo(i + 1, 1) = a(i)
Next i
For i = 1 To UBound(tablo)
    For j = 2 To ncol
        tablo(i, j) = dd(tablo(i, 1) & titre(2, j) & titre(1, j) & dat)
Next j, i
'---restitution---
With dest.Resize(d.Count, ncol)
    .Value = tablo
    .Borders.Weight = xlThin
    .Columns(1).Interior.ColorIndex = 20 'bleu
End With
'---RAZ en dessous---
1 dest.Offset(d.Count).Resize(Rows.Count - d.Count - dest.Row + 1, ncol).Delete xlUp
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Elle se déclenche quand on modifie la date en G1.

Elle est très rapide car elle utilise des tableaux VBA et 2 Dictionary.

A+
 

Pièces jointes

  • Classeur(1).xlsm
    93.6 KB · Affichages: 13

Discussions similaires

Réponses
13
Affichages
339

Statistiques des forums

Discussions
311 733
Messages
2 082 011
Membres
101 866
dernier inscrit
XFPRO