fonction concatener help please

redrock

XLDnaute Nouveau
bonjour à tous.
je suis actuellement en stage et j'ai une nomenclature à étage que je souhaiterais concatener
j'ai un niveau de tête 1 et celui ci a des sous niveau 1,2,3...
Je recherche une formule qui puisse me donner le résultat du fichier joint

merci d'avance pour votre aide.

eric
 

Pièces jointes

  • TEMPLATE.xlsx
    9.1 KB · Affichages: 55
  • TEMPLATE.xlsx
    9.1 KB · Affichages: 60
  • TEMPLATE.xlsx
    9.1 KB · Affichages: 60

hoerwind

XLDnaute Barbatruc
Re : fonction concatener help please

Bonjour,

Cela doit être faisable par formule, mais avant de se lancer dans son écriture il serait bon de préciser ce qu'il faut faire lorsqu'on arrive à un sous-niveau supérieur à 9.

Ne serait-il pas judicieux d'écrire les niveaux en (au moins) deux chiffres, et ceci dès le départ, par exemple : 01.05.12.22
De plus, peut-il il y avoir plus de 4 niveaux (colonne A) ?

Édition :
J'emploie régulièrement ce type de classification, mais j'ai opté pour des lettres, par exemple : ADCL
Avantage : minimum 26 possibilités par sous-niveau (avec les minuscules 52 !), pas besoin de saisir les . (points)
 
Dernière édition:

R@chid

XLDnaute Barbatruc
Re : fonction concatener help please

Bonjour,
tu veux qu'on fasse les formules dans la colonne H ou quoi???
car vraiment je voie pas où est le résultat souhaité...
Amicalement

Edit : Salut les amis, je suis le seul qui n'a pas compris la question :eek::)
 
Dernière édition:

hoerwind

XLDnaute Barbatruc
Re : fonction concatener help please

Salut R@chid,

Ne t'inquiètes pas, j'ai aussi du réfléchir un bon moment avant de comprendre !

Il faut reproduire automatiquement par formule les valeurs de la colonne I en se basant sur les données de la colonne A, qui indiquent le sous-niveau qu'il faut incrémenter.
 

R@chid

XLDnaute Barbatruc
Re : fonction concatener help please

Bonjour @ tous,
Salut Hoerwind,
je voie dans le Titre le mot "Concatener" alors je me suis dit qu'il veut peut être récupérer la dernière valeur en jaune de chaque ligne dans la colonne H, mais non c'est ça.. c'est pas ça :confused:
Amicalement
 

hoerwind

XLDnaute Barbatruc
Re : fonction concatener help please

Mon cher R@chid,

Dans la vie il faut savoir interpréter.
Entre ce qu'on écrit, ce qu'on dit, ce qu'on veut dire et ce qu'on comprend, il peut il y avoir de grandes différences !

A titre d'exemple, lorsque ma femme me dit que sa nouvelle petite robe n'a couté que trois fois rien, elle a raison, mais en partie seulement ... le prix se termine bien par trois zéro !
 

job75

XLDnaute Barbatruc
Re : fonction concatener help please

Bonjour à tous,

C'est un très joli problème pour VBA, j'ai mis un Like au post #1.

Il me semble qu'on ne l'a jamais traité (mais je peux me tromper).

La macro (Alt+F11) est assez conséquente :

Code:
Sub Niveaux()
Dim dep As Range, t$, s, i%, Nmax%, n%
Set dep = ActiveCell
t = "La cellule doit contenir des nombres séparés par des points..."
'---vérifications---
If IsEmpty(dep) Then MsgBox t: Exit Sub
s = Split(dep, ".")
For i = 0 To UBound(s)
  If Not IsNumeric(s(i)) Then MsgBox t: Exit Sub
Next
'---RAZ---
Rows(dep.Row + 1 & ":" & Rows.Count).Clear
Do
  '---entrée du niveau---
  Nmax = Cells(ActiveCell.Row, Columns.Count).End(xlToLeft).Column  - dep.Column + 2
  n = Abs(Val(InputBox("Entrez un nombre entre 1 et " & Nmax, "Niveau à créer")))
  If n = 0 Then Exit Do
  If n > Nmax Then n = Nmax
  '---création du niveau---
  Cells(ActiveCell.Row + 1, n + dep.Column - 1).Select
  dep.Copy ActiveCell
  If n = Nmax Then
    ActiveCell = ActiveCell(0, 0) & ".1"
  Else
    t = ActiveCell.EntireColumn.Find("*", ActiveCell, , , , xlPrevious)
    s = Split(t, ".")
    s(UBound(s)) = s(UBound(s)) + 1
    ActiveCell = Join(s, ".")
  End If
Loop
End Sub
Il y a interaction en permanence avec l'utilisateur.

Fichier joint.

Edition 1 pour redrock : ce serait bien de modifier le titre de cette discussion.

En l'appelant Création d'une arborescence cela permettrait de le retrouver ultérieurement.

Cela dit comme je viens d'écrire les mots clés on le retrouvera quand même...

Edition 2 : j'ai modifié pour que la cellule de départ puisse être quelconque.

A+
 

Pièces jointes

  • TEMPLATE(1).xls
    52.5 KB · Affichages: 42
  • TEMPLATE(1).xls
    52.5 KB · Affichages: 40
  • TEMPLATE(1).xls
    52.5 KB · Affichages: 43
Dernière édition:

redrock

XLDnaute Nouveau
Re : fonction concatener help please

désolé cela n'était pas très clair et la fonction concatener n'est surement pas adapté
j'ai remis un petit fichier explicatif qui vous permettra de mieux comprendre ce que je souhaite


merci d'avance pour votre précieuse aide
eric
 

Pièces jointes

  • TEMPLATE 2.xlsx
    11.2 KB · Affichages: 36

job75

XLDnaute Barbatruc
Re : fonction concatener help please

Re,

Dommage, j'aimais bien le dialogue entre l'ordi et l'utilisateur :)

Alors cette nouvelle macro calquée sur la précédente :

Code:
Sub Niveaux()
Dim plage As Range, dep As Range, restit As Range
Dim t$, s, i%, Nmax%, cel As Range, n%
Set plage = [A2:A15] 'à adapter
Set dep = [C2] 'à adapter
Set restit = [A18] 'à adapter
t = "La cellule " & dep.Address(0, 0) & " doit contenir des nombres séparés par des points..."
'---vérifications---
If IsEmpty(dep) Then MsgBox t: Exit Sub
s = Split(dep, ".")
For i = 0 To UBound(s)
  If Not IsNumeric(s(i)) Then MsgBox t: Exit Sub
Next
'---initialisation---
Application.ScreenUpdating = False
dep(2).Resize(Rows.Count - dep.Row, Columns.Count - dep.Column + 1).Clear
restit.Resize(Rows.Count - restit.Row + 1).Clear
Set cel = dep
dep.Copy restit(1)
For i = 2 To plage.Count
  '---détermination du niveau---
  Nmax = Cells(cel.Row, Columns.Count).End(xlToLeft).Column - dep.Column + 2
  n = Abs(Val(plage(i)))
  If n = 0 Then n = 1
  If n > Nmax Then n = Nmax
  '---création du niveau---
  Set cel = Cells(cel.Row + 1, n + dep.Column - 1)
  dep.Copy cel
  If n = Nmax Then
    cel = cel(0, 0) & ".1"
  Else
    t = cel.EntireColumn.Find("*", cel, , , , xlPrevious)
    s = Split(t, ".")
    s(UBound(s)) = s(UBound(s)) + 1
    cel = Join(s, ".")
  End If
  cel.Copy restit(i)
Next
End Sub
Il me paraît difficile de ne pas reconstituer l'arborescence complète.

Fichier (2).

A+
 

Pièces jointes

  • TEMPLATE (2).xls
    59 KB · Affichages: 36

job75

XLDnaute Barbatruc
Re : fonction concatener help please

Re,

Une disposition plus logique dans ce fichier (3).

Par ailleurs Cells(cel.Row, Columns.Count).End(xlToLeft) c'était... cel.

A+
 

Pièces jointes

  • TEMPLATE (3).xls
    45 KB · Affichages: 51
Dernière édition:

job75

XLDnaute Barbatruc
Re : fonction concatener help please

Bonjour redrock, le forum,

Voici une solution avec tableaux VBA, donc beaucoup plus rapide si les données sont nombreuses.

L'affichage complet de l'arborescence n'est plus nécessaire :

Code:
Sub Arborescence()
Dim plage As Range, restit As Range, derval$()
Dim s, i%, plg, rest, n&, v$, Nmax&
Set plage = Range("A2", [A65536].End(xlUp)) 'à adapter
Set restit = [B2] 'à adapter
If plage.Count = 1 Then Exit Sub 'sécurité
'---initialisation---
ReDim derval(1 To 1)
1 derval(1) = InputBox("Nombre(s) entier(s) (séparés par des points) :", _
  "Premier élément de l'arborescence")
If derval(1) = "" Then Exit Sub
s = Split(derval(1), ".")
For i = 0 To UBound(s)
  If Not IsNumeric(s(i)) Then GoTo 1
  If Int(s(i)) < Abs(s(i)) Then GoTo 1
Next
plage(1) = 1 'au cas où...
plg = plage 'matrices, plus rapide
rest = plage
rest(1, 1) = derval(1)
n = 1
v = derval(1)
For i = 2 To UBound(plg)
  '---détermination du niveau---
  Nmax = n + 1
  n = Abs(Val(plg(i, 1)))
  If n = 0 Then n = 1: plage(i) = 1 'au cas où...
  If n > Nmax Then n = Nmax: plage(i) = n
  '---création du niveau---
  If n = Nmax Then
    v = v & ".1"
    If n > UBound(derval) Then ReDim Preserve derval(1 To n)
  Else
    s = Split(derval(n), ".")
    s(UBound(s)) = s(UBound(s)) + 1
    v = Join(s, ".")
  End If
  derval(n) = v
  rest(i, 1) = v
Next
'---restitution---
With restit.Resize(UBound(rest), 1)
  plage.Copy .Cells 'facultatif, pour les formats
  .NumberFormat = "@" 'format Texte
  .HorizontalAlignment = xlGeneral
  .Value = rest
  .Offset(.Count).Resize(Rows.Count - .Count - .Row + 1).Clear
End With
End Sub
Nouveau fichier joint.

A+
 

Pièces jointes

  • Arborescence avec tableau VBA(1).xls
    58.5 KB · Affichages: 43

job75

XLDnaute Barbatruc
Re : fonction concatener help please

Re,

Voici une solution par formule.

Sélectionner B3 et définir les 3 noms :

- N =NBCAR(Feuil1!$B$2)-NBCAR(SUBSTITUE(Feuil1!$B$2;".";""))

- derval =INDEX(Feuil1!$B$1:$B2;MAX(SI(Feuil1!$A$1:$A2=Feuil1!$A3;LIGNE(Feuil1!$A$1:$A2))))

- pos =TROUVE("x";SUBSTITUE("."&derval;".";"x";N+Feuil1!$A3))

Formule en B3 à tirer vers le bas :

Code:
=SI(A3>A2;B2&".1";GAUCHE(derval;pos-1)&STXT(derval;pos;9^9)+1)
C'est donc nettement plus simple qu'en VBA :)

Fichier joint.

Edit : j'ai modifié le fichier, il est plus logique d'avoir toujours la valeur 1 en A2.

A+
 

Pièces jointes

  • Arborescence par formules(1).xls
    40 KB · Affichages: 39
Dernière édition:

job75

XLDnaute Barbatruc
Re : fonction concatener help please

Bonjour le forum,

En B3 au lieu de :

Code:
=SI(A3>A2;B2&".1";GAUCHE(derval;pos-1)&STXT(derval;pos;9^9)+1)
il vaut mieux écrire :

Code:
=SI(A3=A2+1;B2&".1";GAUCHE(derval;pos-1)&STXT(derval;pos;9^9)+1)
Ainsi toute donnée erronée en colonne A est immédiatement détectée, voir le fichier (2).

Il faut aussi signaler que le recalcul des formules prend du temps.

Voir le fichier Test joint, sur 6502 lignes => 33 secondes sur Excel 2003.

Sur 6502 lignes la macro du post #12 s'exécute en 0,09 seconde.

A+
 

Pièces jointes

  • Arborescence par formules(2).xls
    40 KB · Affichages: 33
  • Test Arborescence par formules.zip
    123.7 KB · Affichages: 24
Dernière édition:

Discussions similaires

Réponses
40
Affichages
1 K

Statistiques des forums

Discussions
312 505
Messages
2 089 067
Membres
104 016
dernier inscrit
Mokson