[Résolu] Ajouter un 0

Benamou39 · 22 Février 2015

Bonjour à tous,

Dans le cadre d'une fonction personnalisée, qui a été crée par les acteurs d'Exceldownload, de mon travail et moi-même, je fais face à une problématique qui à l'air simple au premier abord mais qui me pose bien des difficultés....
Aujourd'hui je gère en manuel, mais je voudrais automatiser cette partie du "programme" VBA.

Mon PB :
J'ai des chaînes de caractères avec des lettres et des chiffres (représentés par lettres AAAA,BBBB,XXXX dans les exemples ci-dessous) et des symboles "." "/" "(" ")" "<".

-> Je dois ajouter un "0" (zéro) dans des chaînes de caractères à certains endroits -> Devant les trois caractères :

Petite illustration :
Au départ Cible
1 AAAA.BBB.CCCC<DDDD.EEEE/FFFF(GGGG) -> AAAA.0BBB.CCCC<DDDD.EEEE/FFFF(GGGG)

2 AAAA.BBBB<CCC.DDDD.EEEE/FFFF.GGGG -> AAAA.BBBB<0CCC.DDDD.EEEE/FFFF.GGGG

3 AAAA.BBBB<CCCC.DDD.EEEE/FFFF.GGG -> AAAA.BBBB<CCCC.0DDD.EEEE/FFFF.0GGG

4 AAAA/BBB -> AAAA/0BBB

5 AAA.BBB.CCC.DDD/EEE.FFFF.GGGG.HHH/IIII.EEE.FFFF/HHH
->
0AAA.0BBB.0CCC.0DDD/0EEE.FFFF.GGGG.0HHH/IIII.0EEE.FFFF/0HHH

Vous trouverez en pièce jointe un fichier avec ces exemples.

A noter que j'obtiens les chaînes de caractère dans une cellule et que je les intègres au cas par cas dans une variable string pour chaque application.

Ce que j'ai déjà fait à ce sujet :
Split -> tableau, pour compter le nombre de caractères (et si < a trois j'ajoute un zéro par conca) mais j'obtiens des bizarreries dans mon résultat final...
Auriez-vous une solution SVP ?

Merci par avance,

Benamou

job75 · 23 Février 2015

Re : [Résolu] Ajouter un 0

Re, bonsoir Martial,

Tu as tout à fait raison, j'avais mal testé.

J'en profite pour simplifier encore la fonction, la variable n était superflue :

Code:

Function AjoutZeroSep(t$, sep$, nombre%)
Dim i%, j%
For i = Len(t) To 1 Step -1
  For j = i To 1 Step -1
    If InStr(sep, Mid(t, j, 1)) Then Exit For
  Next
  If i - j = nombre Then t = Application.Replace(t, j + 1, 0, 0)
  i = j
Next
AjoutZeroSep = t
End Function

Fichier (4).

Bonne nuit.

ROGER2327 · 23 Février 2015

Re : [Résolu] Ajouter un 0

Bonsoir à tous.

Une autre, environ cinq fois plus rapide que la fonction de #13.

Code:

Function toto$(c$, lst$, b%)
Dim i&, v%
  For i = Len(c) To 1 Step -1
    If InStr(1, lst, Mid$(c, i, 1)) Then
      If v = b Then c = Mid$(c, 1, i) & "0" & Mid$(c, i + 1)
      v = 0
    Else
      v = v + 1
    End If
  Next
  If v = b Then c = "0" & c
  toto = c
End Function

Bonne nuit.

ℝOGER2327
#7775

Samedi 28 Gueules 142 (Sainte Hylactor et Pamphagus - fête Suprême Quarte)
4 Ventôse An CCXXIII, 9,8410h - troêne
2015-W08-7T23:37:06Z

job75 · 23 Février 2015

Re : [Résolu] Ajouter un 0

Bonjour Roger, le forum,

Bien vu, mais comparez avec mon post #16.

Chez moi sur Win 7 - Excel 2010 votre fonction est 2,2 à 2,5 fois plus rapide.

Votre fonction 0,19 milliseconde, la mienne 0,47 milliseconde sur la seule cellule F14.

0,98 milliseconde contre 2,18 millisecondes sur les 24 cellules F7:F11 F14:F32.

Conclusion : Application.Replace (REMPLACER) n'est pas la meilleure solution pour faire des insertions.

Bonne journée.

job75 · 23 Février 2015

Re : [Résolu] Ajouter un 0

Bonsoir à tous,

job75 à dit:
Conclusion : Application.Replace (REMPLACER) n'est pas la meilleure solution pour faire des insertions.

Effectivement j'ai testé avec cette modification :

Code:

Function AjoutZeroSep(t$, sep$, nombre%)
Dim i%, j%
For i = Len(t) To 1 Step -1
  For j = i To 1 Step -1
    If InStr(sep, Mid(t, j, 1)) Then Exit For
  Next
  If i - j = nombre Then t = Left(t, j) & "0" & Mid(t, j + 1)
  i = j
Next
AjoutZeroSep = t
End Function

C'est quasiment le même temps que Roger : 1,01 milliseconde pour les 24 cellules.

Fichier (5).

A+

[Résolu] Ajouter un 0

Benamou39

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes