XL 2021 VBA pour générer une liste de valeurs comprise entre 2 valeurs

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

benjy555

XLDnaute Junior
Bonjour a tous et deja merci pour votre aide 🙂

Voici l'idée : je souhaite obtenir en colonne la liste de toutes les valeurs comprises entre 2 valeurs.

En A1 il y a un type : "TOTO" en B1 il y la valeurs "1"et C 1 il y a la valeurs "10"
j'ai besoin que en D1 (peu importe, ou meme dans un nouvel onglet) la macro viennent écrire "TOTO" puis en E1 la valeurs "1" et ensuite en en D2 à nouveau "TOTO" puis en E2 : "2" , D3 "TOTO" et E3 "3" etc jusqu'à "10" en E10

Mais en A2, B2 et C2 il y a encore un nouveau type et 2 autres valeurs, par ex "TATA" "15" et "20" et il faut venir à la suite de D10 donc en D11 mettre "TATA" puis en E11 mettre "15" etc jusqu' "20"

voici l'exemple en fichier excel avec le résultat souhaité en colonne C
pour info dans mon vrai fichier j'ai plus de 14 000 ligne d'intervalles de valeurs d'ou la nécessité de la macro

merci
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
VB: 
Option Explicit
Sub GénNbr()
   Dim TBornes(), TRésu(), L&, C%, N&, LR&
   TBornes = ActiveSheet.[A1].Resize(ActiveSheet.Cells(2 ^ 20, "A").End(xlUp).Row, 2).Value
   ReDim TRésu(1 To 25000, 1 To 1)
   For L = 1 To UBound(TBornes, 1)
      For N = TBornes(L, 1) To TBornes(L, 2)
         LR = LR + 1: TRésu(LR, 1) = N
         Next N, L
   ActiveSheet.[C1:C25000].Value = TRésu
   End Sub
Bonjour.
 
Vote positif 0 Vote négatif
Dranreb à dit:
Option Explicit Sub GénNbr() Dim TBornes(), TRésu(), L&, C%, N&, LR& TBornes = ActiveSheet.[A1].Resize(ActiveSheet.Cells(2 ^ 20, "A").End(xlUp).Row, 2).Value ReDim TRésu(1 To 25000, 1 To 1) For L = 1 To UBound(TBornes, 1) For N = TBornes(L, 1) To TBornes(L, 2) LR = LR + 1: TRésu(LR, 1) = N Next N, L ActiveSheet.[C1:C25000].Value = TRésu End Sub
Cliquez pour agrandir...
merci mais j'ai une erreur de syntax quand je lance cette macro cf sreenshot
est il possible de me rendre le fichier excel directement avec la macro ?
merci
excel.jpg
 
Vote positif 0 Vote négatif
Bon malheureusement je suis bloqué car je ne sais pas modifier cette macro pour l'adapter
si quelqu'un peut m'aider ?

je remet ici le vrai fichier cette fois avec plus de 22 000 lignes car la macro ne fonctionne plus avec autant de ligne (meme en supprimant le champs en colonne A qui est le type)

idéalement il faudrait conserver et répéter le champs en A et dérouler les valeurs comprise entre colonne B et C

merci
 

Pièces jointes

Vote positif 0 Vote négatif
benjy555 à dit:
Bon malheureusement je suis bloqué car je ne sais pas modifier cette macro pour l'adapter
si quelqu'un peut m'aider ?

je remet ici le vrai fichier cette fois avec plus de 22 000 lignes car la macro ne fonctionne plus avec autant de ligne (meme en supprimant le champs en colonne A qui est le type)

idéalement il faudrait conserver et répéter le champs en A et dérouler les valeurs comprise entre colonne B et C

merci
Cliquez pour agrandir...
Bonjour,
Je pense qu'Excel n'est pas l'application idoine pour obtenir ce que tu veux.
Le traitement de ces données renvoie 16 392 579 lignes, soit à peu près 16 la capacité...
Autre option?
 
Vote positif 0 Vote négatif
Le code quand même, au cas où vous parviendriez à limiter ça à environ 22000 lignes :
VB: 
Option Explicit
Sub GénNbr()
   Dim TDonn(), TRésu(), L&, N&, LR&
   TDonn = ActiveSheet.[A1].Resize(ActiveSheet.Cells(2 ^ 20, "B").End(xlUp).Row, 3).Value
   For L = 1 To UBound(TDonn, 1)
      If VarType(TDonn(L, 2)) = vbDouble And VarType(TDonn(L, 3)) = vbDouble Then
         If TDonn(L, 3) >= TDonn(L, 2) Then LR = LR + TDonn(L, 3) - TDonn(L, 2) + 1
         End If
      Next L
   ReDim TRésu(1 To LR, 1 To 1)
   LR = 0
   For L = 1 To UBound(TDonn, 1)
      If VarType(TDonn(L, 2)) = vbDouble And VarType(TDonn(L, 3)) = vbDouble Then
         For N = TDonn(L, 2) To TDonn(L, 3)
            LR = LR + 1: TRésu(LR, 1) = TDonn(L, 1): TRésu(LR, 1) = N
            Next N: End If: Next L
   ActiveSheet.[D:F].ClearContents
   ActiveSheet.[D1].Resize(LR, 3).Value = TRésu
   End Sub
 
Vote positif 0 Vote négatif
bonjour
VB: 
Sub test()
    createtable [a1:c3].Value
End Sub

Sub createtable(tb As Variant)
    Dim t(), InD&, Lig&, A&
    For InD = 1 To UBound(tb)
        For Lig = tb(InD, 2) To tb(InD, 3)
            A = A + 1: ReDim Preserve t(1 To 2, 1 To A): t(1, A) = tb(InD, 1): t(2, A) = Lig
        Next
    Next
    Feuil1.[d1].Resize(A, 2) = Application.Transpose(t)

End Sub

demo1.gif
 
Vote positif 0 Vote négatif
patricktoulon à dit:
bonjour
VB: 
Sub test()
    createtable [a1:c3].Value
End Sub

Sub createtable(tb As Variant)
    Dim t(), InD&, Lig&, A&
    For InD = 1 To UBound(tb)
        For Lig = tb(InD, 2) To tb(InD, 3)
            A = A + 1: ReDim Preserve t(1 To 2, 1 To A): t(1, A) = tb(InD, 1): t(2, A) = Lig
        Next
    Next
    Feuil1.[d1].Resize(A, 2) = Application.Transpose(t)

End Sub

Regarde la pièce jointe 1217220
Cliquez pour agrandir...
Euh,
Regarde le fil, il y a plus de 16 millions de lignes au final, et les colonnes B et C ne sont pas forcément numériques....
Bonne journée
 
Vote positif 0 Vote négatif
Dranreb à dit:
Le code quand même, au cas où vous parviendriez à limiter ça à environ 22000 lignes :
VB: 
Option Explicit
Sub GénNbr()
   Dim TDonn(), TRésu(), L&, N&, LR&
   TDonn = ActiveSheet.[A1].Resize(ActiveSheet.Cells(2 ^ 20, "B").End(xlUp).Row, 3).Value
   For L = 1 To UBound(TDonn, 1)
      If VarType(TDonn(L, 2)) = vbDouble And VarType(TDonn(L, 3)) = vbDouble Then
         If TDonn(L, 3) >= TDonn(L, 2) Then LR = LR + TDonn(L, 3) - TDonn(L, 2) + 1
         End If
      Next L
   ReDim TRésu(1 To LR, 1 To 1)
   LR = 0
   For L = 1 To UBound(TDonn, 1)
      If VarType(TDonn(L, 2)) = vbDouble And VarType(TDonn(L, 3)) = vbDouble Then
         For N = TDonn(L, 2) To TDonn(L, 3)
            LR = LR + 1: TRésu(LR, 1) = TDonn(L, 1): TRésu(LR, 1) = N
            Next N: End If: Next L
   ActiveSheet.[D:F].ClearContents
   ActiveSheet.[D1].Resize(LR, 3).Value = TRésu
   End Sub
Cliquez pour agrandir...
bonjour et merci bcp
desolé du retour tardif

je peux proceder en plusieurs fois et decouper ma donnée source donc cela ira tres bien merci


le pb ici c'est que le type qui est en colonne A n'apparait plus dans le résultat et c'est les infos de la colonne B qui se répètent 3 fois en D, E et F

merci
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon à dit:
bonjour
VB: 
Sub test()
    createtable [a1:c3].Value
End Sub

Sub createtable(tb As Variant)
    Dim t(), InD&, Lig&, A&
    For InD = 1 To UBound(tb)
        For Lig = tb(InD, 2) To tb(InD, 3)
            A = A + 1: ReDim Preserve t(1 To 2, 1 To A): t(1, A) = tb(InD, 1): t(2, A) = Lig
        Next
    Next
    Feuil1.[d1].Resize(A, 2) = Application.Transpose(t)

End Sub

Regarde la pièce jointe 1217220
Cliquez pour agrandir...
merci beaucoup pour tout ça

malheureusement de mon coté la macro ne reagit pas du tout ainsi !

j'ai ajusté avec mon nombre de ligne :
VB: 
createtable [a1:c20543].Value

mais le pb idem que pour l'autre macro c'est que le type qui est en colonne A n'apparait plus dans le résultat et c'est les infos de la colonne B qui se répètent 3 fois en D, E et F

merci
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Question Question
XL pour MAC récupérer les valeurs d’une plage colonne continue à partir d’une plage discontinue.
Réponses
12
Affichages
503
sergio_bzh
S
BenHarber
  • Question Question
Microsoft 365 Fonction pour détecter 2 valeurs approximatives ?
Réponses
1
Affichages
100
crocrocro
C
S
  • Question Question
Microsoft 365 Trouver les correspondances de mots entre deux listes
Réponses
9
Affichages
236
djidji59430
djidji59430
S
  • Question Question
Microsoft 365 Extraire valeurs de courbe de Tendance Polynomiale
Réponses
8
Affichages
338
steepo
S
P
  • Question Question
Microsoft 365 macro qui permet de basculer entre 2 valeurs composées de formules de type "Formula local"
Réponses
3
Affichages
52
cathodique
cathodique
yaka
  • Question Question
Microsoft 365 faire une copie d'un fichier stocké dans un sous sous... sous répertoire
Réponses
8
Affichages
81
Valtrase
Valtrase
A
  • Question Question
Microsoft 365 récupérer des valeurs après un filtre en VBA (pour envoyer des emails)
Réponses
6
Affichages
147
aurejotrail
A
C
  • Résolu(e)
XL 2019 Meilleure option suivant les valeurs
Réponses
7
Affichages
533
cotignac
C
pompaero
  • Question Question
Microsoft 365 Calcul total horaire entre 1er jour et dernier jour de chaque mois
Réponses
5
Affichages
228
pompaero
pompaero
O
  • Question Question
Microsoft 365 Détection valeurs croissante/décroissante dans courbe
Réponses
4
Affichages
295
Oli-excel
O
Y
  • Question Question
Microsoft 365 Suite de mise en forme onditionnelle en fonction dune liste déroulante Compter des valeurs >0.75
Réponses
3
Affichages
256
YGU1
Y
D
  • Question Question
Microsoft 365 Mise à jour des références / liens depuis un sharepoint
Réponses
2
Affichages
141
Dégé59
D
A
  • Question Question
XL 2010 Problème ou alternative à SOMPRODUCT en VBA
Réponses
14
Affichages
470
bruno lemaire
B
A
  • Résolu(e)
Microsoft 365 programme VBA pour "importer" les valeurs de certaines cellules d'une autre feuille appartenant à une ligne que j'identifie par un n°
2
Réponses
27
Affichages
1 K
arnomorize
A
N
  • Résolu(e)
Microsoft 365 Macro entre 2 classeurs
2
Réponses
19
Affichages
428
Nounours4173
N
N
  • Question Question
Microsoft 365 Créer une fenêtre de vente qui alimentera un cumul dans un tableau
Réponses
2
Affichages
226
job75
job75
Y
  • Résolu(e)
XL 2016 Importer des données suivant l'ordre de passage
Réponses
10
Affichages
399
YGU1
Y
PMG
  • Question Question
XL 2021 Déclaration de variables à partir d'une liste de noms
Réponses
8
Affichages
412
PMG
PMG
P
  • Question Question
XL 2016 Macro VBA remplissage tableau de synthèse % déchet ligne de production
Réponses
4
Affichages
260
vgendron
vgendron
O
  • Résolu(e)
Microsoft 365 Générer une heure aléatoire entre 2 heures données. Mais sans les secondes
Réponses
8
Affichages
445
Olihoes
O
Retour