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
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 & CCeci 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 iSi 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 ExplicitFunction 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
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 SubSub Upper_Case()
For Each Cell In Selection
If Cell.HasFormula = False Then
Cell.Value = UCase(Cell.Value)
End If
Next
End SubSub 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 Sub Tester() |
Variables Tableau for vNum = lbound(vArr) to ubound(vArr) |
Sub FillArrayMulti() |
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
L'instruction VBA Evaluate=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)))))
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
'Cette 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 FunctionSub 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