suite de nombre dans une colonne

perrmi

XLDnaute Occasionnel
bonjour ,

j'ai 5 colonnes de chiffres différents.(jamais les memes ).

Dans chaque colonne j'aimerais extraire les suites de nombres (Chiffres)
exemple:
-colonne A :
J'ai les nombres 1...4.5....9.10.11......
-Colonne B:
12...15
-Colonne C:
2...4....6.7.8....13.14
-Colonne D:
16
-Colonne E:
3

j'aimerais donc faire un tableau ou apparaisse les suite de nombres.
pour chaque colonne j'aurai donc :
A= 9-10-11
B=
C=6-7-8
D=
E=

Merci
Michel

je vais essayer d'etre plus precis
ci dessous un tableau


j'aimerais donc creer un tableau pour chaque colonne A-B-C-D-E
Visualiser les suites de nombres
comme ceci
upload_2017-4-9_19-21-52.png

a partir de ce tableau creer un tableau pour visualiser les suites de nombres
comme le tableau ci dessous.
upload_2017-4-9_19-24-21.png
 

Pièces jointes

  • upload_2017-4-9_19-14-17.png
    upload_2017-4-9_19-14-17.png
    8 KB · Affichages: 25
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour perrmi, cathodique,

Il faudrait être plus précis dans l'énoncé du problème.

Dans le fichier joint la 1ère série d'au moins 3 nombres entiers consécutifs est renvoyée.

A+
 

Pièces jointes

  • Séries de 3 nombres consécutifs(1).xlsx
    53.5 KB · Affichages: 31

perrmi

XLDnaute Occasionnel
merci de votre réponse ,j'ai posté une modification de ma question
pour votre réponse ,on s'en approche
merci
la série peux etre une série (suite) de 2 voir 3 ou plus de nombres.
encore merci
Michel

ps chque chiffre doit etre dans une cellule comme mon tableau joint
merci encore
Michel
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour perrmi et bienvenue sur XLD :),

bonjour
merci de votre feedback
je pense etre correct ,poli
pouvez vous me spécifier ou le bas blesse
merci
Michel

Cathodique a voulu gentiment te dire qu'avec un fichier Excel joint, les répondants seront plus enclins à chercher une réponse à ta question. Une image ne sert pas à grand chose et oblige chaque répondant à construire un fichier (pour élaborer et tester la solution); fichier qui en plus ne sera pas sans doute pas identique au tien.

A+ ;)
 

job75

XLDnaute Barbatruc
Re, salut mapomme,

Il faut du VBA et ce n'est pas très simple.

Voici la macro (affectée au bouton) :
Code:
Sub Series()
Dim nlig&, tablo, dest As Range, col%, a(), n&, lig&, nmax&
With [A3:E22] ' tableau source, à adapter
  nlig = .Rows.Count
  tablo = .Resize(nlig + 1) '1 ligne de plus
End With
Set dest = [B27] 'à adapter
For col = 1 To UBound(tablo, 2)
  ReDim a(1 To nlig)
  n = 0
  For lig = 1 To nlig
    If tablo(lig, col) <> "" And tablo(lig + 1, col) = tablo(lig, col) + 1 Then
      n = n + 1
      a(n) = tablo(lig, col)
    ElseIf n Then
      If a(n) <> "" Then
        n = n + 1
        If tablo(lig, col) = a(n - 1) + 1 Then a(n) = tablo(lig, col): If n > nmax Then nmax = n
      End If
    End If
  Next lig
  dest(col).Resize(, nlig) = a
Next col
dest.Resize(col - 1, nlig).Borders.LineStyle = xlNone 'RAZ des bordures
If nmax Then dest.Resize(col - 1, nmax).Borders.Weight = xlThin
End Sub
Fichier joint.

Edit : j'ai ajouté les bordures sur les résultats.

Bonne nuit.
 

Pièces jointes

  • Séries(1).xlsm
    27.5 KB · Affichages: 29
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour perrmi, le forum,

Si le nombre de lignes du tableau source peut dépasser le nombre de colonnes de la feuille il faut disposer les résultats en lignes, fichier (2) et cette macro :
Code:
Sub Series()
Dim nlig&, tablo, dest As Range, col%, a(), n&, lig&, nmax&
With [A3:E22] ' tableau source, à adapter
  nlig = .Rows.Count
  tablo = .Resize(nlig + 1) '1 ligne de plus
End With
Set dest = [G3] 'à adapter
For col = 1 To UBound(tablo, 2)
  ReDim a(1 To nlig, 1 To 1)
  n = 0
  For lig = 1 To nlig
    If tablo(lig, col) <> "" And tablo(lig + 1, col) = tablo(lig, col) + 1 Then
      n = n + 1
      a(n, 1) = tablo(lig, col)
    ElseIf n Then
      If a(n, 1) <> "" Then
        n = n + 1
        If tablo(lig, col) = a(n - 1, 1) + 1 Then a(n, 1) = tablo(lig, col): If n > nmax Then nmax = n
      End If
    End If
  Next lig
  dest(1, col).Resize(nlig) = a
Next col
dest.Resize(nlig, col - 1).Borders.LineStyle = xlNone 'RAZ des bordures
If nmax Then dest.Resize(nmax, col - 1).Borders.Weight = xlThin
End Sub
Edit : pour tester j'ai copié le tableau sur 20 000 lignes => A3:E20002.

Chez moi la macro s'exécute en 0,4 seconde.

Bonne journée.
 

Pièces jointes

  • Séries(2).xlsm
    27.8 KB · Affichages: 29
Dernière édition:

perrmi

XLDnaute Occasionnel
Re, salut mapomme,

Il faut du VBA et ce n'est pas très simple.

Voici la macro (affectée au bouton) :
Code:
Sub Series()
Dim nlig&, tablo, dest As Range, col%, a(), n&, lig&, nmax&
With [A3:E22] ' tableau source, à adapter
  nlig = .Rows.Count
  tablo = .Resize(nlig + 1) '1 ligne de plus
End With
Set dest = [B27] 'à adapter
For col = 1 To UBound(tablo, 2)
  ReDim a(1 To nlig)
  n = 0
  For lig = 1 To nlig
    If tablo(lig, col) <> "" And tablo(lig + 1, col) = tablo(lig, col) + 1 Then
      n = n + 1
      a(n) = tablo(lig, col)
    ElseIf n Then
      If a(n) <> "" Then
        n = n + 1
        If tablo(lig, col) = a(n - 1) + 1 Then a(n) = tablo(lig, col): If n > nmax Then nmax = n
      End If
    End If
  Next lig
  dest(col).Resize(, nlig) = a
Next col
dest.Resize(col - 1, nlig).Borders.LineStyle = xlNone 'RAZ des bordures
If nmax Then dest.Resize(col - 1, nmax).Borders.Weight = xlThin
End Sub
Fichier joint.

Edit : j'ai ajouté les bordures sur les résultats.

Bonne nuit.
Merci de vous etre donné la peine
cela correspond a ce que je recherche
félicitation
je vais essayer maintenant d'inserer le code dans mon classeur excel
bonne journée
perrmi
 

perrmi

XLDnaute Occasionnel
Re, salut mapomme,

Il faut du VBA et ce n'est pas très simple.

Voici la macro (affectée au bouton) :
Code:
Sub Series()
Dim nlig&, tablo, dest As Range, col%, a(), n&, lig&, nmax&
With [A3:E22] ' tableau source, à adapter
  nlig = .Rows.Count
  tablo = .Resize(nlig + 1) '1 ligne de plus
End With
Set dest = [B27] 'à adapter
For col = 1 To UBound(tablo, 2)
  ReDim a(1 To nlig)
  n = 0
  For lig = 1 To nlig
    If tablo(lig, col) <> "" And tablo(lig + 1, col) = tablo(lig, col) + 1 Then
      n = n + 1
      a(n) = tablo(lig, col)
    ElseIf n Then
      If a(n) <> "" Then
        n = n + 1
        If tablo(lig, col) = a(n - 1) + 1 Then a(n) = tablo(lig, col): If n > nmax Then nmax = n
      End If
    End If
  Next lig
  dest(col).Resize(, nlig) = a
Next col
dest.Resize(col - 1, nlig).Borders.LineStyle = xlNone 'RAZ des bordures
If nmax Then dest.Resize(col - 1, nmax).Borders.Weight = xlThin
End Sub
Fichier joint.

Edit : j'ai ajouté les bordures sur les résultats.

Bonne nuit.
Merci de vous etre donné la peine
cela correspond a ce que je recherche
félicitation
je vais essayer maintenant d'inserer le code dans mon classeur excel
bonne journée
perrmi
Re, salut mapomme,

Il faut du VBA et ce n'est pas très simple.

Voici la macro (affectée au bouton) :
Code:
Sub Series()
Dim nlig&, tablo, dest As Range, col%, a(), n&, lig&, nmax&
With [A3:E22] ' tableau source, à adapter
  nlig = .Rows.Count
  tablo = .Resize(nlig + 1) '1 ligne de plus
End With
Set dest = [B27] 'à adapter
For col = 1 To UBound(tablo, 2)
  ReDim a(1 To nlig)
  n = 0
  For lig = 1 To nlig
    If tablo(lig, col) <> "" And tablo(lig + 1, col) = tablo(lig, col) + 1 Then
      n = n + 1
      a(n) = tablo(lig, col)
    ElseIf n Then
      If a(n) <> "" Then
        n = n + 1
        If tablo(lig, col) = a(n - 1) + 1 Then a(n) = tablo(lig, col): If n > nmax Then nmax = n
      End If
    End If
  Next lig
  dest(col).Resize(, nlig) = a
Next col
dest.Resize(col - 1, nlig).Borders.LineStyle = xlNone 'RAZ des bordures
If nmax Then dest.Resize(col - 1, nmax).Borders.Weight = xlThin
End Sub
Fichier joint.

Edit : j'ai ajouté les bordures sur les résultats.

Bonne nuit.
 

perrmi

XLDnaute Occasionnel
Re, salut mapomme,

Il faut du VBA et ce n'est pas très simple.

Voici la macro (affectée au bouton) :
Code:
Sub Series()
Dim nlig&, tablo, dest As Range, col%, a(), n&, lig&, nmax&
With [A3:E22] ' tableau source, à adapter
  nlig = .Rows.Count
  tablo = .Resize(nlig + 1) '1 ligne de plus
End With
Set dest = [B27] 'à adapter
For col = 1 To UBound(tablo, 2)
  ReDim a(1 To nlig)
  n = 0
  For lig = 1 To nlig
    If tablo(lig, col) <> "" And tablo(lig + 1, col) = tablo(lig, col) + 1 Then
      n = n + 1
      a(n) = tablo(lig, col)
    ElseIf n Then
      If a(n) <> "" Then
        n = n + 1
        If tablo(lig, col) = a(n - 1) + 1 Then a(n) = tablo(lig, col): If n > nmax Then nmax = n
      End If
    End If
  Next lig
  dest(col).Resize(, nlig) = a
Next col
dest.Resize(col - 1, nlig).Borders.LineStyle = xlNone 'RAZ des bordures
If nmax Then dest.Resize(col - 1, nmax).Borders.Weight = xlThin
End Sub
Fichier joint.

Edit : j'ai ajouté les bordures sur les résultats.

Bonne nuit.
Merci de vous etre donné la peine
cela correspond a ce que je recherche
félicitation
je vais essayer maintenant d'inserer le code dans mon classeur excel
bonne journée
perrmi
 

Discussions similaires

Statistiques des forums

Discussions
311 722
Messages
2 081 930
Membres
101 843
dernier inscrit
Thaly