Créartion auto d'une suite de nombre dans une cellule

[wiiking73]

Bonjour à tous,

J'ai un problème sur une mise en page d'un fichier excel et j'ai besoin de l'aide de quelqu'un de plus calé que moi

Voila j'ai des cellules où il y a des suite de repères topo (c'est pour l'electronique) qui sont par exemple : R1.R2.R3.R4.R18 etc

Sauf que certaines fois je me retrouve avec des cellules où les repères topos sont dans un format R1-4.R18

Quand j'ai une ou deux cellules avec des petites suites je le fais manuellement mais la je viens de recevoir un fichier avec plus de 30 cellules de ce genre donc je voulais savoir si il existait une formule pour remplacer le tiret par la suite de caractère.

Merci de votre aide.

 

[VDAVID]

Re : Créartion auto d'une suite de nombre dans une cellule

Bonjour Wiiking73,

Tu peux essayer avec ce code :

Sub Remplacer()
Dim myRange As Range
Dim Cell As Range
Set myRange = Range("A1:A30") ' Tu mets ici la plage de donnée que tu veux
For Each Cell In myRange
Cell.Value = Replace(Cell.Formula, "-", "")
Next Cell
End Sub

A placer dans le code de la feuille souhaitée
Bonne journée

 

[job75]

Re : Créartion auto d'une suite de nombre dans une cellule

Bonjour wiiking73, salut VDAVID,

Problème intéressant.

Voyez le fichier joint avec cette fonction VBA :

Function COMPLETE(txt As String)
Dim s, i%, r$, n1&, n2&, t$, n&
s = Split(txt, ".")
For i = 0 To UBound(s)
  If s(i) Like "*-*" Then
    r = Split(s(i), "-")(0)
    n1 = Val(Mid(r, 2, 99))
    r = Left(r, 1)
    n2 = Val(Split(s(i), "-")(1))
    t = ""
    For n = n1 To n2
      t = t & IIf(n > n1, ".", "") & r & n
    Next
    s(i) = t
  End If
Next
COMPLETE = Join(s, ".")
End Function

Il faut que soit respecté le format suivant :

- références constituées d'une lettre suivie d'un nombre entier

- séparées par des points.

A+

 

[job75]

Re : Créartion auto d'une suite de nombre dans une cellule

Re,

Avec cette version (2) les références peuvent commencer par plusieurs lettres :

Function COMPLETE(txt As String)
Dim s, i%, r$, n&, n1&, n2&, t$
s = Split(txt, ".")
For i = 0 To UBound(s)
  If s(i) Like "*-*" Then
    r = Split(s(i), "-")(0)
    For n = Len(r) To 1 Step -1
      If Not IsNumeric(Mid(r, n, 1)) Then Exit For
    Next
    n1 = Val(Mid(r, n + 1, 99))
    r = Left(r, n)
    n2 = Val(Split(s(i), "-")(1))
    t = ""
    For n = n1 To n2
      t = t & IIf(n > n1, ".", "") & r & n
    Next
    s(i) = t
  End If
Next
COMPLETE = Join(s, ".")
End Function

A+

 

[job75]

Re : Créartion auto d'une suite de nombre dans une cellule

Bonjour le fil, le forum,

Le problème inverse (groupement des références) est aussi très intéressant :

Option Explicit
Dim r$, n& 'mémorise les variables

Function GROUPE(txt As String)
Dim s, ub%, i%, ref$, mini&, maxi&, j%
txt = Replace(txt, " ", "") 'pas d'espaces
s = Split(txt, ".")
ub = UBound(s)
For i = 0 To ub - 1
  If s(i) <> "" Then
    Analyse CStr(s(i))
    ref = r
    mini = n
    maxi = n
1   For j = i + 1 To ub
      Analyse CStr(s(j))
      If r = ref Then
        If n = mini - 1 Or n = maxi + 1 Then
          mini = Application.Min(mini, n)
          maxi = Application.Max(maxi, n)
          s(j) = ""
          s(i) = ref & mini & "-" & maxi
          GoTo 1
        End If
      End If
    Next
  End If
Next
GROUPE = Replace(Application.Trim(Join(s)), " ", ".")
End Function

Sub Analyse(t$)
Dim i%
For i = Len(t) To 1 Step -1
  If Not IsNumeric(Mid(t, i, 1)) Then Exit For
Next
n = Val(Mid(t, i + 1, 99))
If i Then r = Left(t, i) Else r = ""
End Sub

C'est la 1ère fois que je crée une Function qui appelle une procédure Sub

Fichier joint.

A+

 

[job75]

Re : Créartion auto d'une suite de nombre dans une cellule

Re,

Pour peaufiner un peu

1) cette fonction qui élimine les références faisant doublon :

Function DOUBLON(txt As String)
Dim s, ub%, i%, j%
txt = Replace(txt, " ", "") 'pas d'espaces
s = Split(txt, ".")
ub = UBound(s)
For i = 0 To ub - 1
  txt = s(i)
  If txt <> "" Then
    For j = i + 1 To ub
      If s(j) = txt Then s(j) = ""
    Next
  End If
Next
DOUBLON = Replace(Application.Trim(Join(s)), " ", ".")
End Function

2) ce fichier (2) qui combine les 3 fonctions sur des références "disparates".

A+

 

[job75]

Re : Créartion auto d'une suite de nombre dans une cellule

Re,

Il manquait encore une chose utile : le classement des références.

Le classement se fait d'abord sur les lettres puis sur les nombres :

Function CLASSE(txt As String)
Dim s, ub%, i%, r1$, n1&
txt = Replace(txt, " ", "") 'pas d'espaces
s = Split(txt, ".")
ub = UBound(s) - 1
1 For i = 0 To ub
  Analyse CStr(s(i)): r1 = r: n1 = n
  Analyse CStr(s(i + 1))
  If r1 > r Or r1 = r And n1 > n Then _
    txt = s(i): s(i) = s(i + 1): s(i + 1) = txt: GoTo 1
Next
CLASSE = Join(s, ".")
End Function

Edit : j'en profite pour simplifier un peu la fonction COMPLETE en lui faisant appeler Analyse.

A+

 

[wiiking73]

Re : Créartion auto d'une suite de nombre dans une cellule

Bonjour à tous
et surtout WAouh!!

Merci beaucoup de vous etre décarcassé comme ça (mieux que Ducros )
En tout cas ça marche exactement comme je le voulais et en plus les ref sont classées, que demande le peuple!!

Bon ben la prochaine fois que j'ai un problème épineux comme celui ci je sais à qui demander

Merci encore

Cdt

 

[wiiking73]

Re : Créartion auto d'une suite de nombre dans une cellule

Du coup dans l'euphorie du moment j'ai même rajouté une petite formule qui compte le nombre de repère topo.

A+