XL 2016 Éclatement de texte sur plusieurs colonnes

[Webperegrino]

Bonsoir Le Forum,
Je bloque dans les macros du bouton "ÉCLATER" du fichier ci-joint, et je viens vous demander un peu de lumière, notamment pour la colonne AS.
Je voudrais afficher des résultats de macros à partir de la ligne 23 (pour le moment) puis plus tard généraliser à partir de la ligne 9.

- ligne 9 à 22 : les colonnes AR à AT et AZ à BD fonctionnent par mes formules initiales.
- au-delà, le fonctionnement se fait par macros du type tablo(i,1) pour plus de rapidité et sans formules dans les cellules précédentes lignes 9-22.
Les macros actuelles ne respectent malheureusement pas tout à fait les formules des cellules au-dessus (parce que je n'arrive pas à les transcrire
parfaitement par VBA)
- quant à la macro commencée pour la colonne AS, je suis vraiment perdu après plusieurs heures de tatonnements de plus en plus catastrophiques...

Cela me serait agréable que vous puissiez me venir en aide pour corriger les macros.
Je vous en remercie à l'avance,
Portez-vous et protégez-vous bien tous,
Webperegrino

 

[Webperegrino]

pour les impatients, en attendant de traiter la zone AT

 

[sylvanu]

Just for the fun.
Avec AT traitée.
NB : Il y a encore une erreur dans le tableau des salles.
On trouve Spec 8 dans Feuil1 mais Salle 8 dans Paramètres. Lequel est correct ?

 

[Webperegrino]

On va mettre Salle 8.
Merci pour la solution #17
J'essaie avec ceci mais ce n'est pas concluant pour le moment :

'colonne AT
'comparer la colonne BB avec Paramètres!D73:E81
'sortir la valeur de Paramètres!colonneE
'et la placer en colonne AT
  With Range("BB8:BB" & dl)
    tablo = .Value
    For i = 1 To UBound(tablo) - 2
        ' si contient ¤ alors Vide
        If tablo(i, 1) Like "*" & "¤" & "*" Then
        tablo(i, 1) = ""
        Else
        tablo(i, 1) = WorksheetFunction.VLookup(tablo(i, 1), Sheets("Paramètres").[D73:E81], 2, False)
                    'Sheets("Paramètres").[D73:E81].Find(What:=tablo(i, 1)) ', LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                    'WorksheetFunction.VLookup(tablo(i, 1).Value, Sheets("Paramètres").Range("D73:E81"), 2, "")
        'autre source de rechercheV du type : Application.WorksheetFunction.VLookup(MyRange, path, 5, False)
        End If
    Next
End With
  With Range("AT8:AT" & dl)
  .Value = tablo
  End With

 

[Webperegrino]

Sylvanu et Le Forum,
J'ai complété dans le message #18

 

[sylvanu]

Donc tout marche ?

 

[Webperegrino]

Non Sylvanu, ça coince toujours avec ceci :

'colonne AT
'comparer la colonne BB avec Paramètres!D73:E81
With Range("BB8:BB" & dl)
  tablo = .Value
  For i = 1 To UBound(tablo)
'[B]message d'erreur à la ligne ci-après[/B]
    tablo(i, 1) = WorksheetFunction.VLookup(tablo(i, 1), Sheets("Paramètres").[D73:E81], 2)
        'autres tentatives de recherchV
        'tablo(i, 1) = WorksheetFunction.VLookup(tablo(i, 1), Sheets("Paramètres").[D73:E81], 2, False)
        'Range("f" & i) = WorksheetFunction.VLookup(Range("f" & i), Range("a2:c10"), 2)
        'Sheets("Paramètres").[D73:E81].Find(What:=tablo(i, 1)) ', LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        'WorksheetFunction.VLookup(tablo(i, 1).Value, Sheets("Paramètres").Range("D73:E81"), 2, "")
        'Application.WorksheetFunction.VLookup(MyRange, path, 5, False)
'  End If
  Next
End With
With Range("AT8:AT" & dl): .Value = tablo: End With

Mais super belle note positive : tout le reste fonctionne parfaitement, grâce à vous, et je vais pouvoir transposer tout cela dans mon application source "Usine à gaz".

 

[Webperegrino]

Wouah ! J'y suis presque avec :

'colonne AT
'comparer la colonne BB avec Paramètres!D73:E81
With Range("BB8:BB" & dl)
  tablo = .Value
  For i = 1 To UBound(tablo)
    tablo(i, 1) = Application.VLookup(tablo(i, 1), Sheets("Paramètres").[D73:E81], 2, False)
  Next
End With
With Range("AT8:AT" & dl): .Value = tablo: End With

J'ai mis SALLE 8 aux bons endroits.
Il me reste des #N/A pour ligne 8, 138 et 139.
Je suis proche du résultat parfait !

 

[Webperegrino]

Le Forum,
MERCI Sylvanu, merci encore :
Et voici le résultat.
C'est parfait.

Peut-on compresser encore mes lignes de macro ?
par exemple rassembler tous les "With Range("D8:" & dl)" dans un seul "With Range("D8:" & dl)" ?
Webperegrino

 

[sylvanu]

Comme dit au post #13, on peut optimiser car vous avez 4 With Range("D8" & dl) , on peut surement optimiser.
Cependant, n'oubliez pas la maintenance. Optimiser c'est bien, mais il faut s'en souvenir dans 6 mois.
Si ça marche et que la vitesse vous va, améliorez juste les commentaires pour ... demain quand il faudra remanier ou faire évoluer le code.
en attendant, bravo.

 

[Webperegrino]

merci Sylvanu, vous me portez au-delà de ce j'espérais.
Je laisse mes lignes ainsi.
Merci Le Forum, et pour mettre RESOLU sur le #1 ?

 

[sylvanu]

Préfixe "Résolu" et "Marquer comme solution"

Voici la nouvelle façon de faire suite à la mise à jour du 22/12/2020 : https://www.excel-downloads.com/threads/forums-aux-questions.20052158/ (obsolète suite à la mise à jour du 22/12/2020) Bonjour, Les personnes posant des questions dans le forum souhaitent souvent pouvoir indiquer que les...

www.excel-downloads.com

 

[Webperegrino]

C'est vrai, laissons-le "ouvert" à toute nouveau perfectionnement.
Encore merci
nota : l'image de votre identité est superbe.
Webperegrino

 

[Webperegrino]

Bonjour Le Forum,
Bonjour Sylvanu,
Pour ceux qui sont intéressés par cette programmation :
Je n'ai pas pu résister à réduire les lignes de programmation, maintenant que je comprends mieux la solution de Sylvanu.
Bon usage,
Cordialement, Webperegrino

 

[Webperegrino]

Bonjour Le Forum,
Toute la programmation est achevée et tout fonctionne à merveille comme je le désirais et je peux transposer les codes dans ma vraie application (une usine à gaz).
Le fichier final, corrigé, est placé en #28 et a remplacé la précédente mouture.
Vous y trouverez les colonnes AW et AX traitées en supplément, grâce à des solutions apportées par Staple 1600 et Marcel32, remerciés pour cela dans une autre discussion.
Bon usage pour ceux qui veulent s'en inspirer.
Webperegrino