Split en fonction de majuscule ou minuscule

[nicroq]

bonsoir,
voici ma problematique, je souhaiterai par VBA séparer les caracteres d une cellule en fonction de si il s agit de majuscule ou minuscule ou d un chiffre et de reconcatener tout ca apres modification...

Mon fichier joint sera bien plus clair et evitera des explications pas claires afin d obtenir la case reformulation.

Merci bcp pour votre aide!!!!

cdlt

 

[cp4]

Merci beaucoup Dranreb. Je ne connaissais pas cette façon de déclarer une variable.
Le VBA est vaste et grâce à vous, j'apprends toujours quelque chose à chacune de mes connexions.

Encore merci.

 

[Dranreb]

nicroq, ce n'était pas seulement une petite erreur dans la mesure où vous n'aviez pas confirmé qu'il pouvait y avoir plusieurs séquences entre parenthèses. Ça change une nouvelle fois complètement Reformu :

Function Reformu(ByVal Z As String) As String
Dim TS1() As String, P1 As Long, TS2() As String, P2 As Long, _
   TS3() As String, Fin As String, M As Long
TS1 = Split(Replace(Z, " ", ""), ",")
For P1 = 0 To UBound(TS1)
   TS2 = Split(TS1(P1), "(")
   TS2(0) = RFMult(TS2(0), 1)
   For P2 = 1 To UBound(TS2)
      TS3 = Split(TS2(P2), ")")
      M = TêteÉliminée(TS3(1))
      TS2(P2) = RFMult(TS3(0), M) & RFMult(TS3(1), 1): Next P2
   TS1(P1) = Join(TS2, ""): Next P1
Reformu = Join(TS1, "")
End Function

À tester.

Pour récupérer le nombre de tous les atomes, dans plusieurs formules, il faudrait déjà en récupérer le nombre dans chacune d'elles.

Je vais écrire une Function qui renvoie un Dictionary à partir d'une formule traitée par Reformu, avec pour clés les atomes dans leur ordre de 1ère apparition, et pour items leurs nombres. Il vous faudra cocher la référence Microsoft Scripting Runtime pour l'utiliser.

Ça devrait être quelque chose comme ça :

Function DicAtomes(ByVal Z As String) As Dictionary
Dim P As Long, C As String * 1, N As Long, Clé As String
Set DicAtomes = New Dictionary
For P = 1 To Len(Z)
   If C Like "#" Then
      N = 10 * N + C
   Else
      If N > 0 Then
         DicAtomes.Item(Clé) = DicAtomes.Item(Clé) + N
         Clé = "": N = 0: End If
      Clé = Clé & C: End If: Next P
DicAtomes.Item(Clé) = DicAtomes.Item(Clé) + N
End Function

 

[nicroq]

excusez moi pour l' histoire des parenthèses qui peuvent revenir je n'avais pas fait attention a votre question précédemment.
Sincèrement merci bcp cela fonctionne tres bien et c 'est tres efficace.
cependant je n'arrive pas à utiliser votre dernière fonction pour compter l'ensemble des atomes?

 

[Dranreb]

J'avais oublié l'instruction C = Mid$(Z, P, 1)

Function DicAtomes(ByVal Z As String) As Dictionary
Dim P As Long, C As String * 1, N As Long, Clé As String
Set DicAtomes = New Dictionary
For P = 1 To Len(Z): C = Mid$(Z, P, 1)
   If C Like "#" Then
      N = 10 * N + C
   Else
      If N > 0 Then
         DicAtomes.Item(Clé) = DicAtomes.Item(Clé) + N
         Clé = "": N = 0: End If
      Clé = Clé & C: End If: Next P
DicAtomes.Item(Clé) = DicAtomes.Item(Clé) + N
End Function

Sub Test()
Dim DicTot As New Dictionary, DicFml As Dictionary, TK(), _
   N As Long, Atom As String, Résu(0 To 3) As String
  
Set DicFml = DicAtomes("C6O6H12")
TK = DicFml.Keys
For N = 0 To UBound(TK)
   Atom = TK(N)
   DicTot(Atom) = DicTot(Atom) + DicFml(Atom)
   Next N

Set DicFml = DicAtomes("Na1O1H1")
TK = DicFml.Keys
For N = 0 To UBound(TK)
   Atom = TK(N)
   DicTot(Atom) = DicTot(Atom) + DicFml(Atom)
   Next N
  
TK = DicTot.Keys
For N = 0 To UBound(TK)
   Atom = TK(N)
   Résu(N) = Atom & ": " & DicTot(Atom)
   Next N
MsgBox Join(Résu, ", ") & "."
End Sub

La Sub Test affiche : C: 6, O: 7, H: 13, Na: 1.

 

[nicroq]

J'ai une erreur sur : Function DicAtomes(ByVal Z As String) As Dictionary

Type defini par lutilisateur non defini...

 

[Dranreb]

Contrairement à ce que je disais au poste #17, vous n'êtes pas allé, dans VBA, menu Outils, Références…, cocher, parmi les références disponibles, la Microsoft Scripting Runtime.

 

[nicroq]

ah ok cela marche bien mais je n'arrive pas à l adapter de facon a obtenir comme dans le fichier joint (tableau rouge):

 

[Dranreb]

Sub Adaptation()
Dim TDon(), L As Long, DicTot As New Dictionary, DicFml As Dictionary, TK(), _
   N As Long, Atom As String
TDon = Feuil2.[B3].Resize(Feuil2.[B1000000].End(xlUp).Row - 2).Value
For L = 1 To UBound(TDon, 1)
   Set DicFml = DicAtomes(TDon(L, 1))
   TK = DicFml.Keys
   For N = 0 To UBound(TK)
      Atom = TK(N)
      DicTot(Atom) = DicTot(Atom) + DicFml(Atom)
      Next N, L
Feuil2.[E2:F2].Resize(DicTot.Count).Value = WorksheetFunction.Transpose(Array(DicTot.Keys, DicTot.Items))
End Sub

 

[nicroq]

C 'est genial merci beaucoup! vous etes trop efficace c est top et reactif!!!!
j'ai une ultime requete pour cloturer ce que je souhaite :
est il possible ,au lieu de lister dans un tableau , de plutot choisir quel atome on veux par exemple
en range J2 : le nombre d' atome C
en range J3 : le nombre d atome H

cela me permet de juste choisir les atomes dont je veux le nombre plutot que de tout lister.

 

[Dranreb]

Eh bien récupérez les noms d'atomes que vous voulez de la colonne E (ou J ?) dans une table TAtom, un peu comme on a récupéré les formules traitées dans TDon, dans une boucle For L = 1 To UBound(TAtom, 1) faites des TAtom(L, 1) = DicTot(TAtom(L, 1)) puis déchargez la dans la colonne F

 

[nicroq]

ok mais comme l ordre des atomes peut changé j'aurais preferé que si en range I4 j ai un "C" alors en J4 je peux avoir le nombre d atome C etc....

 

[nicroq]

sinon je vais me debrouiller avec un Find et ca devrait le faire !!
encore merci pour votre patience et votre aide
bonne soirée

 

[Dranreb]

Pourquoi réagissez vous comme ça ?
Si vous avez le nom de l'atome, DicTot(CeNomDAtome) voue donne, le total, pour cet atome !
Simplement ne travaillez jamais directement avec les cellules: c'est long. Toujours par l'intermédiaire de tableaux VBA en mémoire.
Au fond ça se rapproche de ce que j'avais fait à la fin dans la Sub Test, sauf qu'au lieu de prendre TK des clés du DicTot il faut les prendre de la colonne des clés imposées.

 

[nicroq]

Je suis désolé mais je n'arrive pas a adapter votre code en modifiant DicTot...
Pourriez vous me montrer le code entier pour l'exemple de l atome C...
je debute en VBA et esseye de comprendre et d analyser le code a chaque etape mais la je bloque...

 

[nicroq]

je souhaiterai remplir directement le tableau en vert ds le fichier joint enfait sans passer par le tableau en rouge.