Simplification d'un programme

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Je cherche simplement à reporter les valeurs d'une colonne dans un tableau grâce à un code VBA.

Pièce jointe 596330

La capture d'écran correspond au but final (en sachant que normalement les valeurs sont des chaines de caractères).

J'ai trouvé un code qui fonctionne mais je pense que ce n'est pas la manière "officielle" :mouarf:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
     Range("F2:F9").Copy
     Range("J13:J20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F10:F17").Copy
     Range("K13:K20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F18:F25").Copy
     Range("L13:L20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F26:F33").Copy
     Range("M13:M20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F34:F41").Copy
     Range("N13:N20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F42:F49").Copy
     Range("O13:O20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F50:F57").Copy
     Range("P13:P20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F58:F65").Copy
     Range("Q13:Q20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F66:F73").Copy
     Range("R13:R20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F74:F81").Copy
     Range("S13:S20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F82:F89").Copy
     Range("T13:T20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues
     Range("F90:F97").Copy
     Range("U13:U20").Select
     ActiveCell.PasteSpecial Paste:=xlPasteValues

Voilà, si quelqu'un peut m'aider à simplifier tout ça ce serait cool, merci d'avance.

1 pièce(s) jointe(s)

Salut.

En me basant sur ton exemple, donc avec les positions "en dur" dans le code, on pourrait utiliser le code suivant:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub test() Dim r As Long Dim Target As Range Dim i As Long r = Range("f1048576").End(xlUp).Row Set Target = Range("j13:j20") For i = 2 To r Step 8 Target.Value = Cells(i, 6).Resize(8).Value Set Target = Target.Offset(0, 1) Next End Sub
Pièce jointe 596339

Principe:

On cherche la dernière ligne utilisée en F;
On définit J13:J20 comme première plage cible;
on boucle par pas de 8 de F2 jusqu'à la dernière cellule renseignée en F;
On transfère les valeurs sur la place cible;
On décale la cible d'une colonne vers la droite.

22/04/2021, 15h34
joe.levrai

1 pièce(s) jointe(s)

Bonjour,

cela est possible sans VBA, autant en profiter

Code:

=SI(INDIRECT(ADRESSE(LIGNE()-1+8*(COLONNE()-4);1))=0;"";INDIRECT(ADRESSE(LIGNE()-1+8*(COLONNE()-4);1)))

La liste est en colonne A et débute en ligne 1
Le tableau est en C1:O9

8 Représente le nombre de lignes de ton tableau de résultat
4 Représente le décalage de colonnes entre la liste et le tableau de résultat
1 représente le décalage entre le début de la liste et le début du tableau des résultats
Pièce jointe 596340
22/04/2021, 15h43
Pierre Fauconnier

Salut Joe ;)

J'ai supposé que c'était un exo en VBA :mouarf:
22/04/2021, 15h49
Robycoco

Parfait pour le VBA et l'explication est très claire Pierre merci beaucoup !

Merci également Joe j'avais vraiment besoin d'une réponse en VBA mais pour une autre fois la formule proposée me sera certainement utile, merci !

Bonne journée à vous deux.
22/04/2021, 16h02
Pierre Fauconnier

1 pièce(s) jointe(s)

Juste pour le fun

Avec DECALER, un peu plus court qu'avec INDIRECT, en se servant des équations de droite. Avec la même disposition des données: =DECALER($J13;8*COLONNE()-91;-4) ;)

Pièce jointe 596349

Ok ok :mrgreen:

On prend ma méthode en VBA, la copie écran avec les positionnement reste inchangé
J'ai utilisé une plage nommée "DESTINATION" pour les cellules du tableau de résultat
Code:

1 2 3 4 5 6 Sub toto() With ThisWorkbook.Worksheets("Feuil1").Range("DESTINATION") .Formula = "=IF(INDIRECT(ADDRESS(LIGNE()-1+8*(COLUMN()-4),1))=0,"""",INDIRECT(ADDRESS(LIGNE()-1+8*(COLUMN()-4),1)))" .Value = .Value ' si on veut écraser les formules par leur valeur End With End Sub

22/04/2021, 16h13
Pierre Fauconnier

Alors je prends la mienne qui est plus courte ^(*) : Range("j13:o20").Formula = "=IF(OFFSET($J13,8*COLUMN()-91,-4)=0,"",OFFSET($J13,8*COLUMN()-91,-4))"^(**)

^(*) hum, oui, je sais... :mouarf:

^(**) C'est quand même franchement con, cette histoire de 0...
22/04/2021, 17h05
joe.levrai

Sauf à modifier les options Excel pour ne rien afficher si 0 :roll:
Mais je déconseille

Ps : oui, c'est les blagues les plus courtes les plus bonnes :ptdr:
22/04/2021, 17h16
Pierre Fauconnier

Oui, mais perso, j'aurais mieux vu l'inverse: L'option par défaut renvoie du vide et si on veut modifier, on coche pour renvoyer 0... Ca me paraîtrait plus logique. Ils pourraient inventer une fonction SI.VIDE(Calcul;Valeur) un peu comme ils ont fait avec SIERREUR() et SI.NON.DISP(). Ca éviterait le double calcul.

On peut +/- l'éviter avec LET, mais c'est ch**** et limité aux 365: =LET(a;DECALER($J13;8*COLONNE()-91;-4);SI(a=0;"";a)) en Excel et Range("j13:o20").Formula = "=LET(a,OFFSET($J13,8*COLUMN()-91,-4),IF(a=0,"""",a))" en VBA.