Voir aussi xl_format.htm

Concaténation de cellules

L'action de concaténer est l'action de mettre bout à bout une ou plusieurs valeurs quelconques (numériques textes ou autres) pour en faire une chaîne. Voilà ci-dessous quelques exemples de formules et de quoi vous inspirer pour des concaténations en VBA.

=concatener(A1;"-";A2)
=concatener(nb.si(A1:A10="Absent")&Absences)
=concatener(A1&A1&A1....)  !!
=SI(ET(A1<>"";A2<>"");CONCATENER(A1;"-";A2);"")
on peut rajouter un "si" pour prévoir les cas ou A2 serait vide

Il est possible de concaténer du texte au résultat d'une formule. L'exemple ci-dessous concatène le résultat d'une somme avec un espace puis la valeur de la cellule B1 de la feuille "Feuil1".
=somme(B2:B15)& " " & feuil1!B1
=sum(B2:B15) & " " & sheet1!B1


Sous VBA, vous trouverez l'instruction "concatenate", mais il est plus simple d'utiliser les opérateurs & et +.
Fonction pour concaténer le contenu d'une ou plusieurs plages : news

 


Nombre d'occurences d'une chaîne

Si une cellule contient la valeur texte oui dans A1 alors le résultat sera C2 * A2, sinon zéro
=SI(ESTERREUR(TROUVE("oui";A1));0;C2*A2)
=if(iserror(search("yes",A1)),0,C2*A2)

Compter le nombre de lettres A dans une plage (où les mots font 7 caractères) :
=SOMME(N(STXT(A1:A8663;{1.2.3.4.5.6.7};1)="A")) à valider par Ctrl-Maj-Entrée.
Nombre de A : =NBCAR(A1)-NBCAR(SUBSTITUE(A1;"A";""))
Nombre de "A" et "À" dans une cellule : =NBCAR(A1)-NBCAR(SUBSTITUE(SUBSTITUE(A1;"A";"");"À";""))

Trouver la n ième occurence d'une chaîne : news
Nombre de cellules contenant du texte dans la plage B3:B8 : =SUM(ISERROR(B3:B8/B3:B8)*1)
Nombre de mots dans une cellule : =LEN(SUBSTITUTE(TRIM(A1),CHAR(32),CHAR(32)&CHAR(32)) )-LEN(TRIM(A1))+1
Dernier mot dans une cellule : =TRIM(CALL("Crtdll","strrchr","CCI",A1,32))

Compter un nombre de mots : news (ne tient compte que des espaces)
Macro pour recenser le nombre de mots dans X classeurs de répertoires : news (tient compte de plusieurs paramètres)
    si vous sélectionnez un lecteur sur une autre machine, n'utilisez pas l'appel à la fonction ChoisirDossier, mais indiquez en dur le dossier de votre choix au début de la procédure Compte. Remplacer : Dossier = ChoisirDossier 'choix du dossier à examiner, par : Dossier = "IciLeCheminDeTonDossier" '(sans antislash final)

voir aussi la partie Dénombrement de chaînes de caractères : xl_denombrement.htm
Des infos supplémentaires : http://members.aol.com/rexx03/excel/strings.htm

 


 

Extraction de chaînes

Extractions à l'aide des fonctions de feuille de calcul

Méthode STXT
De: Jacques Ghemard, Objet: Re: aide sur fonction STXT, Date : mardi 19 septembre 2000 21:43

STxt renvoie un nombre donné de caractères extraits d'une chaîne de texte à partir de la position que vous avez spécifiée.
Syntaxe : STXT(texte;no_départ;no_car)

texte représente la chaîne de texte contenant les caractères à extraire.

no_départ représente la position dans le texte du premier caractère à extraire. Le premier caractère de texte a un no_départ égal à 1, et ainsi de suite.

Si no_départ est supérieur à la longueur de texte, STXT renvoie une chaîne vide ("").
Si no_départ est inférieur à la longueur de texte, mais que no_départ plus no_car dépasse la longueur de texte, STXT renvoie tous les caractères jusqu'à la fin de texte.
Si no_départ est inférieur à 1, STXT renvoie la valeur d'erreur #VALEUR!

no_car indique le nombre de caractères à extraire de texte. Si no_car est négatif, STXT renvoie la valeur d'erreur #VALEUR!

Exemples

STXT("Cours moyen"; 1; 5) égale "Cours"
STXT("Cours moyen"; 7; 20) égale "moyen"
STXT("1234"; 5; 5) égale "" (texte vide)

Pour d'autres exemples, reportez-vous à la fonction CODE et TROUVE.

 

Méthodes Left & Right

En français

En anglais

=droite(A1;nbcar(A1)-trouve(",";A1;1))

=right(A1,nb(A1)-search(",",A1,1))

=gauche(A1;trouve(",";A1;1)-1)

=left(A1,search(",",A1,1)-1)

Différence entre Right & Right$ (news), autre explication : news

Instruction Mid

Je vous conseille de lire l'aide VBA à ce sujet. Elle explique que l'on peut distinguer une fonction Mid et une instruction Mid.
La fonction Mid permet de renvoyer un nombre de caractères déterminé parmi ceux composant une chaîne :
lemot = Mid("Ma chaîne", 4) => la valeur retournée est "chaîne"
lemot = Mid("Ma chaîne", 4,4 ) => la valeur retournée est "chaî"

L'instruction Mid
yemplace un nombre indiqué de caractères dans une variable de type Variant (String) par des caractères extraits d'une autre chaîne.
Dim MyString
MyString = "Le chien saute" ' Initialise la chaîne.
Mid(MyString, 4, 5) = "lapin" ' MyString = "Le lapin saute".
Mid(MyString, 4) = "boeuf" ' MyString = "Le boeuf saute".

Démonstration des instructions Left & Mid
Sub Test()
dim cel As range
for each cel In thisworkbook.worksheets("A").range("Original")
    thisworkbook.worksheets("B").cells(cel.Row, cel.Column) = Trim(Mid(cel, InStr(cel, ",") + 1, Len(cel)))
    thisworkbook.worksheets("B").cells(cel.Row, cel.Column + 1) = Trim(Left(cel, InStr(cel, ",") - 1))
next
end Sub

Exemples divers d'extraction

Soit le texte "Somme France" en A1 ( généré par la fonction données/sous totaux ), je souhaite recopier en C1 uniquement le nom du pays =STXT(A1;7;NBCAR(A1)-6) Soit le texte "Somme_" identique au début de chaque cellule : =DROITE(A1;NBCAR(A1)-6) Pour un texte variable avant le premier espace : =DROITE(A1;NBCAR(A1)-cherche(" ";A1;1))


Extraire un code postal (dixit le groupe de discussion microsoft.public.fr.excel)

function zaza_postal(texte)
for rang = 1 to Len(texte) - 4
if Mid(texte, rang, 5) Like "#####" then
zaza_postal = Mid(texte, rang, 5)
end if
next
end function

=> msgbox zaza_postal(range("A1").Text)

Autres méthodes d'extraction : Parse & TextToColumns, Characters

Worksheets("feuil1").Columns("A").Parse parseLine:="[xxx] [xxxxxxxx]", destination:=Worksheets("feuil1").range("B1")
'Ceci permet de dispatcher les trois premiers caractères et les suivants des valeurs de la colonne A dans la colonne B & C

Ceci est l'équivalent de la méthode utilisé pour l'importation de fichiers
Selection.TextToColumns destination:=range("A1"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(8, 1))

Afficher les trois premiers caractères de A1
MsgBox [A1].Characters(1, 3).Text (extraction partir du 1err caractère jusqu'au 3ième)


Méthode Split pour Excel 2000

Cette méthode a été indiquée dans le forum microsoft.public.fr.excel, sujet "Re: recuperation de lettre/mot entre un caractere special".
Split permet de découper le contenu de caractères en plusieurs chaînes en tenant compte d'un séparateur et insère dans une variable tableau les différentes portions. Pour savoir combien de portions ont générées, on utilise l'instruction UBound qui retourne la dimension supérieure de la variable tableau.

La macro ci-dessous utilise la méthode pour découper le texte contenu dans la cellule active, sachant que ces différents portions sont séparées par le signe _. Puis elle recopie chaque portion dans la colonne 1 (en supposant que la cellule active n'est pas dans la colonne 1).

Dim Donnees
Donnees = Split(ActiveCell.Value, "_")

for i=0 to ubound(Donnees)
cells(i+1,1).value =Donnees(i)
next i

Si vous voulez insérer dans C1 la troisième portion, vous pouvez faire : Range("C1").Value = Donnees(2).
Attention l'indexation commence à zéro (donnees(0),donnees(1), donnees(2), ...)

Exemple alambiqué pour dispatcher une chaine composée de tabulations (par Stratos M.)

Option Explicit

Function fncPastewoPaste(SourceString As String, TargetRange As Range)
  Dim TempSourceString As String, ValuesArray As Variant
  Dim TempTargetRange As Range
  TempSourceString = SourceString
  TempSourceString = Application.Substitute(TempSourceString, Chr(34), Chr(34) & Chr(34))
  TempSourceString = Application.Substitute(TempSourceString, vbTab, Chr(34) & "," & Chr(34))
  TempSourceString = Application.Substitute(TempSourceString, vbCr, Chr(34) & ";" & Chr(34))
  TempSourceString = "{""" & TempSourceString & """}"
  ValuesArray = Evaluate(TempSourceString)
  Set TempTargetRange = TargetRange.Cells(1, 1).Resize(UBound(ValuesArray, 1), UBound(ValuesArray, 2))
  TempTargetRange.Value = ValuesArray
  Set TempTargetRange = Nothing
End Function


Sub test()
Dim MyString As String
MyString = "This" & vbTab & "is" & vbTab & "a" & vbTab & "test" & vbCr & _
                 "This" & vbTab & "is" & vbTab & "a" & vbTab & "test" & vbCr & _
                 "This" & vbTab & "is" & vbTab & "a" & vbTab & "test" & vbCr & _
                 "This" & vbTab & "is" & vbTab & "a" & vbTab & "test"
Call fncPastewoPaste(MyString, Range("E10"))
End Sub

 


 

Remplacement de texte

Remplacer les retours chariot

si les données sont dans la plage A1:A100, sélectionne B1, entre la formule =SUBSTITUE(A1;CAR(10);" "),
puis recopie-la jusqu'à B100. Ensuite, fais un copier / collage spécial valeurs uniquement de B1:B100 vers A1:A100.

 Remplacer les espaces

Plusieurs méthodes, portant le même nom "Trim" permettent d'enlever les espaces. Il faut préférer la méthode Trim applicable à l'objet application, qui enlève tout les espaces d'une chaîne, la méthode VBA Trim classique enlève que les espaces au début et à la fin de la chaîne). Deux exemples :

'Méthode plus efficace
Sub TrimSUB()
  'David McRitchie mod.2000-09-28  programming
  'VBA TRIM removes only lead/trailing spaces,
  'Application.TRIM also removes multi & internal spaces
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Dim icell As Range
  On Error Resume Next
  For Each icell In Intersect(Selection, _
       Selection.SpecialCells(xlConstants, xlTextValues))
     icell.Value = Application.Trim(icell.Value)
  Next icell
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

'L'autre méthode
Sub RemoveSpaces()
Dim Cell As range
For Each Cell In Selection
Cell.Value = Trim(Cell.Text)
Next Cell
End Sub


Effacer tous les caractères inutiles (espace, "carrés")

Cette macro est proposée sur le site Xl-Logic, elle consiste à boucler sur toutes les cellules sélectionnées en s'assurant que chacun de leurs caractères figurent parmi ceux notés dans le code la macro, sauf les espaces, carrés et autres caractères incongrus.

Sub CleanUp()
For Each cell In ActiveWindow.RangeSelection
With cell
oldfmt = .NumberFormat
n$ = .Value
filt$ = ""
For i = 1 To Len(n$)
char$ = Mid(n$, i, 1)
Select Case char$
Case "A" To "z", "a" To "z", 0 To 9, ",", "!", ".", "?"
filt$ = filt$ & char$
End Select
Next i
.NumberFormat = "@"
.Value = filt$
.NumberFormat = oldfmt
End With
Next cell
End Sub

'NOTE:
'I'm aware of the fact that I could use the UCASE function in VBA 'to include upper and lower case alpha-characters, but in this example, 'it's just as easy to specify "A" to "Z", "a" to "z". Afterall, I 'may not always want to allow upper and lower case so I prefer to be 'case explicit.

Fonction REPT & Complétion de cellules

Dans des cellules contenant du texte ne dépassant jamais 8 car. mais pouvant en avoir moins, comment peut-on faire pour définir un format sur 8 carcatères obligatoirement (l'équivalent du format nombre "00000" mais pour du texte) ??
De: Bernard R., Objet: Re: Nombre de caractères fixes dans une cellule texte, Date : vendredi 15 septembre 2000 12:19

 

=REPT("x";8-NBCAR(A1)) & A1

Et surtout, regarder la fonction VBA Substitute
Vous trouverez des exemples intéressants dans les fichiers "SupprimerLesAccents1"  & "SupprimerLesAccents2" sur le site de Frédéric S., ces macros remplacent toutes les accentuations ou presque se trouvant dans une chaîne.

 


 

Majuscules, miniscules ...

Il y a plusieurs solutions et autant de variantes que d'utilisateurs excel :-))
Un premier exemple

Sub Upper_Convert()
'// Convert all constants on a sheet to UPPER Case
'// Dana DeLouis: dana2@msn.com
dim rng As range
for each rng In cells.Specialcells(xlConstants).Areas
rng = Evaluate("UPPER(" & rng.address & ")")
next
end Sub

Autre exemple de Catherine : news

Vous avez la possibilité d'utiliser une police qui n'a pas de minuscules comme CopperPlate Gothic, et aussi Felix titling et Engravers pour les polices à empatement (genre Times...) et CornerstoneRegular et Metro Regular pour les polices sans empatements (genre Arial).

Trois macros pour changer la casse

Sub Lower_Case()
For Each Cell In Selection
If Cell.HasFormula = False Then
Cell.Value = LCase(Cell.Value)
End If
Next
End Sub

Sub Upper_Case()
For Each Cell In Selection
If Cell.HasFormula = False Then
Cell.Value = UCase(Cell.Value)
End If
Next
End Sub

Sub Proper_Case()
For Each Cell In Selection
If Cell.HasFormula = False Then
Cell.Value = Application.Proper(Cell.Value)
End If
Next
End Sub

Autre exemple de formatage en Nom Propre

Sub MakeProper()
Dim Rng As Range
For Each Rng In Selection.Cells
Rng.Value = StrConv(Rng.Value, vbProperCase) 'attention, je crois que c'est pour XL2000
Next Rng
End Sub
' on pourrait écrire aussi selection.SpecialCells(xlCellTypeConstants, xlTextValues) pour ne s'intéresser qu'aux valeurs texte

Passer en majuscules les strings éventuellement saisies dans la plage A1:A10
par Laurent L., sujet: Re: Format 'transformer en majuscules' en Excel 97 , le mercredi 2 février 2000

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Cell As Range
If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Cell In Target
If VarType(Cell) = vbString And Not Cell.HasFormula Then Cell = UCase(Cell)
Next Cell
Application.EnableEvents = True
End Sub

Passer la première lettre en majuscule

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
Target = UCase(Left$(Target, 1)) & Mid$(Target, 2)
Application.EnableEvents = True
End Sub

 


 

Chaînes & variables tableau/ Strings & array variables (voir aussi xl_vba_1.htm)

Transformer une chaîne en variables tableau/ Strings into array
function MakeChararray(sString) As Variant
dim BytArr() As Byte
dim vArr() As Variant
BytArr = sString
redim vArr(1 to (ubound(BytArr) - LBound(BytArr) + 1) / 2)
J = 0
for i = LBound(BytArr) to ubound(BytArr) Step 2
J = J + 1
vArr(J) = Chr$(BytArr(i))
next i
MakeChararray = vArr
end function

Sub Tester()
dim sStr As String
sStr = "the quick brown fox"
vStringArr = MakeChararray(sStr)
for i = 1 to ubound(vStringArr)
Debug.Print i, vStringArr(i)
'msgbox vStringArr(i)
next
end Sub

Variables Tableau

for vNum = lbound(vArr) to ubound(vArr)
msgbox varr(vNum)
next

Sub FillArrayMulti()
dim intI As Integer, intJ As Integer
dim sngMulti(1 To 5, 1 To 10) As Single

' Remplit le tableau de valeurs.
For intI = 1 To 5
For intJ = 1 To 10
sngMulti(intI, intJ) = intI * intJ
Debug.Print sngMulti(intI, intJ)
Next intJ
Next intI
end Sub

 


 

Diverses autres actions sur les chaines et caractères

Tester si un caractère existe : existence.htm#exis_caractere
Un caractère existe-t-il dans une chaine : news
Nombre de caractères uniques dans une chaine : news
Taille en pixels d'une chaine de caractères : news
Attribuer de couleurs différentes dans une même cellule : xl_format.htm#format_couleur
Comparer deux chaines de caractères : news, news, deux soluces par Eric Jeanne
Comparaison de chaines sous EXCEL 2000 avec la méthode StrComp

l'exemple ci-dessous qui utilise deux variables tableaux
xxx = StrComp(chaines1(i), chaines2(j), 1) 'textual comparison
msgbox i & " " & chaines1(i) & " " & j & " " & chaines2(j) & " " & xxx

Incrémentation de caractères/lettres (en ligne) une série du style Adobe, Bdobe,Cdobe, Ddobe

=CAR(CODE(GAUCHE(A1;1))+1)&DROITE(A1;NBCAR(A1)-1)
The following returns true if 1st character is a letter and false if it doesn't. : =NOT(ISNUMBER(value(LEFT(D7,1))))
Modified to reject blank cells meaning ISBLANK (empty, never used), and cells containing only space(s).
=IF(LEFT(TRIM(D7))="","",NOT(ISNUMBER(value(LEFT(D7,1)))))

L'instruction VBA Evaluate

Cette instruction est très utile, plus qu'on ne le croit (encore plus en javascript). Elle permet de demander au programme excel d'interpréter une chaîne comme une instruction.
Admettons que vous écrivez en A1, "5*4", exécutez msgbox (evaluate([A1].text) et vous verrez le résultat de 5*4
Ci-dessous, j'ai écrit une fonction qui vous permet d'utiliser evaluate "dans une formule".

function Eval(Expression As String)
Eval = Evaluate(Expression)
end function
utilisez dans A2 la fomule = Eval(A1), cela donnera bien 20


Retourner la lettre associé à un chiffre
=> A=0, B=1, Z=25

function CHIFFRESENLETTRES(Nombre As long) As String
Dim I As Integer
For I = 1 To Len(CStr(Nombre))
CHIFFRESENLETTRES = CHIFFRESENLETTRES _
& Chr$(Asc(Mid$(Nombre, I, 1)) + 17)
Next I
End function
'Ensuite, dans une cellule, tapez par exemple : =CHIFFRESENLETTRES(1234567890)

Récupérer trois caractères de chaque mot d'une cellule

Function RecupCar(Texte) As String
Dim LongueurTexte As Integer
Dim i As Integer
    Texte = Application.Trim(Texte)
    LongueurTexte = Len(Texte)
    RecupCar = Left(Texte, 3) & " "
    For i = 2 To LongueurTexte
        If Mid(Texte, i, 1) = Chr(32) Then
            RecupCar = RecupCar & Mid(Texte, i + 1, 3) & " "
        End If
    Next i
End Function

Valeur ASCII d'un ou plusieurs caractères
'C
ette fonction retourne la valeur ASCII du caractère ou les valeurs des caractères séparées par un point
'Notamment proposée par Frédéric S. sur son site

Function CodASCII$(txtin$)    'Denis Pasquier, mpfe

Dim i As Integer
 CodASCII = ""
 For i = 1 To Len(txtin)
  CodASCII = CodASCII & Asc(Mid(txtin, i, 1))
  If i < Len(txtin) Then
   CodASCII = CodASCII & "."
  End If
Next i
End Function

Sub Test()
MsgBox CodASCII$("abcedf")
End Sub

'Trouve un caractère dans une chaîne (only backwards ?)

Function RevInStr(findin As String, tofind As String) As Integer
    ' Chris Rae's VBA Code Archive - http://chrisrae.com/vba
    Dim findcha As Integer
    For findcha = Len(findin) - Len(tofind) + 1 To 1 Step -1
        If Mid(findin, findcha, Len(tofind)) = tofind Then
            RevInStr = findcha
            Exit Function
        End If
    Next findcha
    ' Defaults to zero anyway (tsk, tsk, etc)
End Function