Récupérer les éléments d'un tableau

[Magic_Doctor]

Bonsoir,

Sur un autre fil, mapomme m'avait donné cette astuce (mais pour une toute autre raison).
Je voudrais maintenat l'utiliser pour séctionner des cellules dans une feuille, à savoir :
Dans la feuille il y a des cellules où peuvent apparaître "? ? ?" en cas d'erreur.
Je voudrais alors les sélectionner toutes pour leur donner un format différent, exactement centrer les "? ? ?" dans leur cellule pour que ça accroche davantage l'œil.
En utilisant la macro de mapomme :

Sub ListeEnBleu()
'mapomme

Dim xcell As Range, tablo(), n&

    For Each xcell In [Bigplage] '"Bigplage" étant une plage de cellules nommée, qui correspond à l'aire de travail sur la feuille
        If xcell = "? ? ?" Then
            n = n + 1
            ReDim Preserve tablo(1 To 1, 1 To n)
            tablo(1, n) = xcell.Address(0, 0)
        End If
    Next xcell
    
    If n > 0 Then tablo(1, n).HorizontalAlignment = xlCenter 'essai pour rigoler --> cata totale !!
    
End Sub

Comment s'y prendre pour sélectionner toutes les cellules comportant "? ? ?" à partir de ce code ?

Merci pour toute réponse

 

[job75]

Re : Récupérer les éléments d'un tableau

Bonjour Magic_Doctor, le forum,

Sub Centrer()
Dim t
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  t = .Formula
  .Value = .Value 'supprime les formules
  .Replace "? ? ?", "#N/A", xlWhole
  On Error Resume Next
  .SpecialCells(xlCellTypeConstants, 16).HorizontalAlignment = xlCenter
  .Formula = t
End With
End Sub

Bonne journée.

 

[CHALET53]

Re : Récupérer les éléments d'un tableau

Bonjour,

Pourquoi un tableau ?

Sub ListeEnBleu()
'mapomme

Dim xcell As Range, tablo(), n&

For Each xcell In [Bigplage] '"Bigplage" étant une plage de cellules nommée, qui correspond à l'aire de travail sur la feuille
If xcell = "? ? ?" Then
xcell.Select
With Selection
.HorizontalAlignment = xlCenter
End With
' n = n + 1
' ReDim Preserve tablo(1 To 1, 1 To n)
' tablo(1, n) = xcell.Address(0, 0)
End If
Next xcell

' If n > 0 Then tablo(1, n).HorizontalAlignment = xlCenter 'essai pour rigoler --> cata totale !!

End Sub

a+

 

[mapomme]

Re : Récupérer les éléments d'un tableau

Bonjour Magic_Doctor, Chalet53,

Pour une question de rapidité et d'adaptation au nouveau problème, je pense qu'il vaut mieux user d'une autre méthode (fichier v1).

Dans le fichier v1 joint, il y a deux procédures:

1. l'une (Init) initialise une plage de cellules avec un certain pourcentage de cellules valant "? ? ?"
2. l'autre (ListEnCouleur) est la procédure principale qui repère et formate les cellules "? ? ?"

• pour le test, la plage est déterminée par une constante en début du code

• le ratio des cellules valant "? ? ?" est déterminé par la valeur en E1. Changer cette valeur, provoque l'initialisation. Par ex. saisir 7,5 dans la cellule E1, aboutira à ce que 7,5 % des cellules de la plage soient égales à "? ? ?"

Le code est commenté (un peu).

Edit: sinon il y a la méthode classique de boucler sur les cellules et de formater à chaque cellule "? ? ?" trouvée.

 

[job75]

Re : Récupérer les éléments d'un tableau

Re, bonjour CHALET53, mapomme,

Si le recalcul des formules prend beaucoup de temps il est peut-être mieux en effet de formater les cellules une par une.

On peut aussi utiliser un document auxiliaire :

Sub Centrer()
Dim sel As Range, f As Worksheet
Application.ScreenUpdating = False
ActiveCell.Activate 'si un objet est sélectionné
Set sel = Selection 'mémorise
With ActiveSheet.UsedRange
  Set f = Workbooks.Add.Sheets(1) 'nouveau document
  .Copy
  f.[A1].PasteSpecial xlPasteValues
  f.[A1].PasteSpecial xlPasteFormats
  f.UsedRange.Replace "? ? ?", "#N/A", xlWhole
  On Error Resume Next
  f.UsedRange.SpecialCells(xlCellTypeConstants, 16).HorizontalAlignment = xlCenter
  f.UsedRange.Copy
  .Cells.PasteSpecial xlPasteFormats
  f.Parent.Close False
End With
sel.Select
End Sub

A+

 

[job75]

Re : Récupérer les éléments d'un tableau

Re,

J'ai testé sur 30 000 lignes avec le fichier joint.

Vu le grand nombre d'informations copiées il faut vider la mémoire :

Sub Centrer()
Dim t, sel As Range, f As Worksheet
t = Timer
Application.ScreenUpdating = False
ActiveCell.Activate 'si un objet est sélectionné
Set sel = Selection 'mémorise
With ActiveSheet.UsedRange
  Set f = Workbooks.Add.Sheets(1) 'nouveau document
  .Copy
  f.[A1].PasteSpecial xlPasteValues
  f.[A1].PasteSpecial xlPasteFormats
  f.UsedRange.Replace "? ? ?", "#N/A", xlWhole
  On Error Resume Next
  f.UsedRange.SpecialCells(xlCellTypeConstants, 16).HorizontalAlignment = xlCenter
  f.UsedRange.Copy
  .Cells.PasteSpecial xlPasteFormats
  f.[A1].Copy f.[A1] 'vide la mémoire
  f.Parent.Close False
End With
sel.Select
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Chez moi sur Win 8 - Excel 2013 la macro s'exécute en 12 secondes.

A+

 

[job75]

Re : Récupérer les éléments d'un tableau

Re,

Bon finalement inutile de se casser la tête, ceci s'exécute en 8,5 secondes :

Sub CentrerCellules()
Dim t, c As Range
t = Timer
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
  If c = "? ? ?" Then c.HorizontalAlignment = xlCenter
Next
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Fichier (2).

A+

 

[mapomme]

Re : Récupérer les éléments d'un tableau

Bonjour job75,

En voulant tester ta version sur mes données, je me suis heurté à un petit problème: après exécution de la macro, toutes mes cellules étaient centrées .
J'ai trouvé pourquoi. Les valeurs de mes données initialisées sont soit "? ? ?" soit "$ Y S". Les deux valeurs correspondent à la valeur à remplacer dans l'instruction Replace puisque ? est en fait un caractère générique. Il suffit de chercher "~? ~? ~?" au lieu "? ? ?" et tout rentre dans l'ordre. Magic_Doctor est facétieux !

 

[job75]

Re : Récupérer les éléments d'un tableau

Re,

L'utilisation d'un tableau VBA ne fait pas gagner de temps :

Sub CentrerCellulesTableau()
Dim t, plage As Range, tablo, ub%, i&, j%
t = Timer
Application.ScreenUpdating = False
Set plage = ActiveSheet.UsedRange
If plage.Count = 1 Then Set plage = plage.Resize(2) 'au moins 2 cellules
tablo = plage 'matrice
ub = UBound(tablo, 2)
For i = 1 To UBound(tablo)
  For j = 1 To ub
    If tablo(i, j) = "? ? ?" Then plage(i, j).HorizontalAlignment = xlCenter
Next j, i
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Fichier (3).

A+

 

[job75]

Re : Récupérer les éléments d'un tableau

Re,

Avec plusieurs mises en forme l'avantage revient à la 1ère méthode :

- fichier (1 bis) => 11,5 secondes

- fichier (2 bis) => 19,2 secondes

- fichier (3 bis) => 19,2 secondes.

A+

 

[DoubleZero]

Re : Récupérer les éléments d'un tableau

Bonjour, le Fil , le Forum,

Ma petite contribution...

Option Explicit
Sub Là_et_là_puis_là_et_ailleurs()
    Dim c As Range, où As Range, quoi
    Application.ScreenUpdating = False
    Columns(1).Insert
    [a1] = "? ? ?"
    Set où = Range("a1")
    quoi = [a1].Value
    If quoi = "" Then Exit Sub
    For Each c In ActiveSheet.UsedRange
        If c.Value = quoi Then Set où = Union(où, c)
    Next c
    With où: .Interior.ColorIndex = 36: .HorizontalAlignment = xlCenter: End With
    Columns(1).Delete
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[job75]

Re : Récupérer les éléments d'un tableau

Bonjour chère ânesse

Avec un grand nombre de zones disjointes la méthode avec Union pose problème.

Teste donc sur mon fichier de 30 000 lignes :

Sub CentrerCellulesUnion()
Dim t, c As Range, P As Range
t = Timer
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
  If c = "? ? ?" Then Set P = Union(IIf(P Is Nothing, c, P), c)
Next
If Not P Is Nothing Then
  P.HorizontalAlignment = xlCenter
  P.Interior.ColorIndex = 6 'jaune
  P.Font.ColorIndex = 3 'rouge
  P.Font.Bold = True 'gras
End If
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Tu te lasseras...

En fait pour utiliser cette méthode il faut procéder à des décharges régulières de P.

Je verrai ça ce soir, je pars en Normandie.

A+

 

[job75]

Re : Récupérer les éléments d'un tableau

Re, avant de partir,

Avec un pas de 100 (180 décharges) on descend à 5 secondes :

Sub CentrerCellulesUnion()
Dim t, pas, c As Range, n, P As Range
t = Timer
pas = 100 'modifiable
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
  If c = "? ? ?" Then Set P = Union(IIf(n, P, c), c): n = n + 1
  If n = pas Then
    n = 0
    P.HorizontalAlignment = xlCenter
    P.Interior.ColorIndex = 6 'jaune
    P.Font.ColorIndex = 3 'rouge
    P.Font.Bold = True 'gras
  End If
Next
If n Then
  P.HorizontalAlignment = xlCenter
  P.Interior.ColorIndex = 6 'jaune
  P.Font.ColorIndex = 3 'rouge
  P.Font.Bold = True 'gras
End If
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Fichier joint.

A+

 

[Magic_Doctor]

Re : Récupérer les éléments d'un tableau

Bonjour à tous,

Décidément, j'ai l'embarras du choix !

Je vais donc regarder tout ça en détail.

En revanche, je suis peut-être têtu, mais peut-on récupérer, dans la macro, les items (en l'occurrence des adresses de cellules) d'un tableau pour les rassembler de telle sorte qu'ils constituent une plage ?

Merci à tous et très une bonne soirée.

 

[DoubleZero]

Re : Récupérer les éléments d'un tableau

Re-bonjour,

Bonjour chère ânesse

Avec un grand nombre de zones disjointes la méthode avec Union pose problème.

Teste donc sur mon fichier de 30 000 lignes... Tu te lasseras...

Cher jb75 : c'est faux ! Je ne me suis pas lassée mais endrmie !

Beau séjour en Normandie, grs merci et à bientôt,