j'ai fait la même chose en remplaçant le virgule par des tab dans notepad ++ et j'arrive au même résultat!
j'ai fait la même chose en remplaçant le virgule par des tab dans notepad ++ et j'arrive au même résultat!
@joelevrai: oui seulement une, mais j'ai besoin de l'intégralité des données, rangées dans les bonnes colonnes (il y a plusieurs molécules et autres infos dans le fichier excel)
@rdurupt: il faut de toutes façons passer par excel, je dois aussi changer la 'molecular formula" de chaque molécule pour y rajouter ou enlever 1,0 et quelques en fonction de mes analyses avant l'export (si on peut faire ça via le module ce serait chouette, du style une invite qui demande si on doit ajouter ou retirer ce chiffre dans la colonne...)
je voie que nous commençons à être d'accord sur la notion d'import dans Excel même si au finale le but est d'enregistre l'onglet au format Csv!
je me rends compte également que le fichier est est bien un fichier texte mais que les champs Molecular Formula | Chemical Name ont une forme de XML ton fichier est a mi-chemin entre un fichier a plat et un Xml!
et qu'il faut connaitre le processus qui converti cet xml en champs Molecular Formula | Chemical Name!!!
En attendant que notre super technicien rdurupt concrétise une solution optimale ...
voici une solution très triviale !
Il faut que tu modifies le chemin du fichier .txt et que tu ajustes le nom du classeur et de la feuille.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79 Option Explicit Sub Elsassblitz() Dim Chaine As String Dim F_Txt As String Dim Liste() As String Dim ListeRemplace() As Variant Dim k As Integer Dim i As Integer Dim l As Integer Dim j As Integer Dim Derlig As Integer ' chemin du fichier .txt F_Txt = "U:\exemple.txt" ' la liste des balises et caractères qu'on va supprimer ListeRemplace = Array("<html>", "</html>", "<sub>", "</sub>", "<small>", "</small>", "<i>", "</i>", """") With ThisWorkbook.Worksheets("Feuil1") .UsedRange.Delete ' importation du .txt .QueryTables.Add("TEXT;" & F_Txt, [A1]).Refresh ' dernière ligne Excel de l'extraction du .txt Derlig = .Range("A" & Rows.Count).End(xlUp).Row ' on démarre la mise en forme 2 lignes en dessous de l'extraction k = 2 ' pour chaque ligne d'exportation du .txt For i = 1 To Derlig ' on éclate la ligne en utilisant le séparateur "," ' ATTENTION : les formules chimiques de la 4è colonne contiennent des virgules ' on traitera ce dernier champs séparément Liste = Split(.Range("A" & i), ",") ' on supprime les balises For l = LBound(ListeRemplace) To UBound(ListeRemplace) For j = LBound(Liste) To UBound(Liste) Liste(j) = Replace(Liste(j), ListeRemplace(l), "") Next j Next l ' on traite les 3 premiers champs du listing For j = 0 To 2 ' on écrit la valeur du champs .Range("A" & Derlig + k).Offset(0, j) = Liste(j) Next j ' on prend une variable String vide Chaine = "" ' à partir de la 4è valeur de liste ' on est en fait sur le 4ème champs qui est éclaté en plusieurs morceaux ' en raison d'éventuelles virgules présentes dans le nom chimique For j = 3 To UBound(Liste) ' on reconstitue le nom chimique en y repositionnant les virgules Chaine = Chaine & Liste(j) & "," Next j ' on écrit la valeur du quatrième champs (en supprimant les deux dernières virgules inutiles) .Range("A" & Derlig + k).Offset(0, 3) = Mid(Chaine, 1, Len(Chaine) - 2) ' on se décale d'une ligne pour écrire la ligne de .txt suivante k = k + 1 Next i End With End Sub
je sais pas si on peut me qualifier de super technicien! mais de super critique oui! mais dans un but constructif!
je verrais plus qq chose comme ça!
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38 Sub test() Dim Fichier As String Dim Txt Dim Ligne Dim L As Long Fichier = "c:\ExportOpenSourceApp.txt" Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.GetFile(Fichier).Size = 0 Then Exit Sub Set oTxt = FSO.OpenTextFile(Fichier, 1) Txt = oTxt.ReadAll oTxt.Close Set oTxt = Nothing Set FSO = Nothing Txt = Split(Txt, vbCrLf) For i = 0 To ubond(Txt) If i = 0 Then txt2 = Split(Txt(i), ",") ActiveSheet.Range("A1:D1") = txt2 Else txt2 = Split(Txt(i),chr(34) & "," & chr(34)) ActiveSheet.Range(ActiveSheet.Range("A1").Offset(L), ActiveSheet.Range("B1").Offset(L)) = txt2 txt3 Split(txt2(UBound(txt2) - 1), "<html>") txt4 Split(txt2(UBound(txt2)), "<html>") txt3 =ConvertMolecularFormula(txt3) txt4 =ConvertChemicalName(txt4) ActiveSheet.Range("C1").Offset(L) =txt3 ActiveSheet.Range("D1").Offset(L) = txt4 End If L = L +1 Next End Sub Function ConvertMolecularFormula(Tableau) as string 'Code???? end Function Function ConvertChemicalName(Tableau) as string 'Code???? end Function
Dernière modification par Invité ; 23/03/2015 à 12h51.
Merci à vous deux pour vos exemples (merci de préciser les fonctions joe.levrai car je n'y connais rien en Visual Basic). Donc si j'ai bien compris, cela permet de supprimer les balises et de mettre en forme le fichier.
Mes questions sont:
-peut-on rajouter une ligne pour exporter dans le répertoire d'origine du txt le fichier CSV au même nom (ou je ne sais pas si une invite avec ouverture d'un gestionnaire de fichier est possible)?
-peut-on rajouter une ligne pour changer le nom des colonnes?
-peut-on aussi rajouter une ligne pour ajouter/retirer le chiffre 1,0 à la colonne "Molecular Weight" (cela dépend de l'analyse à faire en fait: dans une analyse il faut que je calcule la masse +1 et un autre la masse -1).
Jusqu'où le VBA peut aller? Est-ce que vous auriez peut-être un site de référence ou les fonctions sont notées, que je comprenne un peu mieux tout ce code?
J'avoue être novice en la matière. Je vois très bien ce que je veux faire mais après va savoir si tout est faisable en VBA... Je vais tester vos code dans Excel.
Merci pour votre temps consacré à ma requête!
ElsassBlitz.
J'apporte mon grain de sel
Edit: pour le beta, ajouter .TextFilePlatform = 65001
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43 Option Explicit Sub Refonte() Dim Fichier As String Dim LastLig As Long Dim c As Range Fichier = "C:\Users\hp\Desktop\exemple.txt" With Feuil1 .UsedRange.Clear With .QueryTables.Add(Connection:="TEXT;" & Fichier, Destination:=.Range("A1")) .TextFilePlatform = 65001 .TextFileParseType = xlDelimited .TextFileCommaDelimiter = True .Refresh BackgroundQuery:=False .Delete End With LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row For Each c In .Range("C2:D" & LastLig) Sample c Next c End With End Sub 'Activer la référence MSForms n.n Object Library Private Sub Sample(ByVal Rng As Range) Dim objData As MSForms.DataObject Dim sHTML As String sHTML = Rng.Text sHTML = Replace(sHTML, "<html>", "<html><style>br{mso-data-placement:same-cell;}</style>") Set objData = New DataObject With objData .SetText sHTML .PutInClipboard End With Rng.PasteSpecial Set objData = Nothing End Sub
Cordialement.
J'utilise toujours le point comme séparateur décimal dans mes tests.
tu peux si tu le souhaite tout faire en vba sans passer par une feuille excel!
mais avant il faut que tu précise quelle piste correspond à tes attentes, car plus on est sur une solution plus la solution sera il serra aisé de te réponde!
ma solution sous-entant qu'il faut reconstituer les champs Molecular Formula | Chemical Name et là comment?
les autres sous-entendent qu'il suffi de supprimer les balises html ce qui revient à faire un csv avec des différences de colonage ce qui n'est pas forcément faut!
Bonjour à tous
ATTENTION, ATTENTION
Il ne faut surtout pas virer les balises !!!!!!
Excel comprend parfaitement les balises et les traduits ce qui permet d'obtenir une vraie formule chimique
donc je pense qu'il faut récuperer les moceaux entre les guillements (") et le collé mais sans les guillemets
Je me permets d'ajouter que les (,) ne sont pas forcement des séparateurs ! Cf ligne 2 colonne 4
j'ai pas le temps de faire une macro je laisse le soins autres posteurs (que je salue) de le faire
A+
Ils ne savaient pas que c'était impossible ... du coup ils l'ont fait (Mark Twain)
n'oubliez pas de si les messages vous aide ou sont pertinents et de mettre quand cela est !
Bonjour,
A noter que la solution de mercatog est (comme toujours) la meilleure : les mises en forme HTML apparaissent bien
Concernant ma proposition :
seule la colonne 4 contient effectivement des virgules qui ne sont pas des séparateurs.
c'est la raison pour laquelle mon exemple "trivial" traite cette colonne différemment : je reconstitue cette colonne on concaténant tous les splits s'y rapportant.
concernant l'utilité des balises, pour la formule chimique, cela concerne la mise en exposant ou indice des numéros.
Malheureusement, après avoir testé plusieurs méthodes, c'est la formule + les balises HTML qui s'affichent, et pas la formule chimique avec la mise en forme des balises
Il fallait donc passer par le presse papier ... solution de mercatog
Merci Igloobel pour le travail d'analyse!
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28 Sub test() Dim Fichier As String Dim Txt Dim Ligne Dim L As Long Fichier = "c:\ExportOpenSourceApp.txt" Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.GetFile(Fichier).Size = 0 Then Exit Sub Set oTxt = FSO.OpenTextFile(Fichier, 1) Txt = oTxt.ReadAll oTxt.Close Set oTxt = Nothing Set FSO = Nothing Txt = Split(Txt, vbCrLf) For I = 0 To ubond(Txt) If I = 0 Then txt2 = Split(Txt(I), ",") ActiveSheet.Range("A1:D1") = txt2 Else txt2 = Split(Txt(I), Chr(34) & "," & Chr(34)) ActiveSheet.Range("A1").Offset(L) = Replace(txt2(0), Chr(34), "") ActiveSheet.Range("B1").Offset(L) = Replace(txt2(1), Chr(34), "") ActiveSheet.Range("C1").Offset(L) = Replace(txt2(2), Chr(34), "") ActiveSheet.Range("D1").Offset(L) = Replace(txt2(3), Chr(34), "") End If L = L + 1 Next End Sub
Petite coquille dans ton code rdurupt :
ligne 15 : Ubound (tu as écris Ubond)
quand je teste, ça ne ressort que la première ligne (les entêtes du .txt)
Je pense qu'on peut laisser Elsassblitz nous confirmer que la solution de mercatog est conforme.
Ensuite on pourra reprendre à partir de ça, et ajouter ses demandes annexes ?
ceci dit il reste la gestion de HTML dans la colonne C & D mais là j'ai pas le temps!
je regarde ce soir!
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36 Sub test() 'Dim Fichier As String 'Dim Txt 'Dim Ligne 'Dim L As Long 'Fichier = "c:\ExportOpenSourceApp.txt" 'Set FSO = CreateObject("Scripting.FileSystemObject") 'If FSO.GetFile(Fichier).Size = 0 Then Exit Sub 'Set oTxt = FSO.OpenTextFile(Fichier, 1) 'Txt = oTxt.ReadAll 'oTxt.Close 'Set oTxt = Nothing 'Set FSO = Nothing Txt = "C2C Number,Molecular Weight,Molecular Formula,Chemical Name," Txt = Txt & vbCrLf & """AAA"",""428.709"",""<html>C<sub>78</sub>H<sub>52</sub>O</html>"",""<html>Cyclolol</html>""," Txt = Txt & vbCrLf & """BBB"",""255.249"",""<html>C<sub>120</sub>H<sub>110</sub>O<sub>15</sub></html>"",""<html>3,4',5,7-Tetralol(1+)</html>""," Txt = Txt & vbCrLf & """CCC"",""112.231"",""<html>C<sub>110</sub>H<sub>116</sub>1O</html>"",""<html>2-Methyl-6-methylene-2,7-lol</html>""," Txt = Txt & vbCrLf & """DDD"",""61.132"",""<html>C<sub>217</sub>H<sub>311</sub>O<sub>116</sub></html>"",""<html>3,3',4',5,7-Pentahydrlol; 3,7-Di-<i>O</i>-ß-<small>D</small>-glucolol</html>""," Txt = Txt & vbCrLf & """EEE"",""63.552"",""<html>C<sub>229</sub>H<sub>321</sub>O<sub>129</sub></html>"",""<html> 3,5-diglylol; Bis(monosaccharides), 3,5-Bis-(<i>O</i>-oxalyl-ß-<small>D</small>-glucolol)</html>""," Txt = Txt & vbCrLf & """FFF"",""53.442"",""<html>C<sub>139</sub>H<sub>331</sub>O<sub>139</sub></html>"",""<html>3,3',4',5,7-Pentalol; 3,7-Di-<i>O</i>-oxalyl-ß-<small>D</small>-glucolol</html>""," Txt = Txt & vbCrLf & """GGG"",""1810.246"",""<html>C<sub>141</sub>H<sub>146</sub>O<sub>5</sub></html>"",""<html>2-Ethyl-5-1,3-cyclolol</html>""," Txt = Split(Txt, vbCrLf) For I = 0 To UBound(Txt) If I = 0 Then txt2 = Split(Txt(I), ",") ActiveSheet.Range("A1:D1") = txt2 Else txt2 = Split(Txt(I), Chr(34) & "," & Chr(34)) ActiveSheet.Range("A1").Offset(L) = Replace(txt2(0), Chr(34), "") ActiveSheet.Range("B1").Offset(L) = Replace(txt2(1), Chr(34), "") ActiveSheet.Range("C1").Offset(L) = Replace(txt2(2), Chr(34), "") ActiveSheet.Range("D1").Offset(L) = Replace(txt2(3), Chr(34), "") End If L = L + 1 Next End Sub
Juste parce que j'aimerais comprendre
Le "L" tu l'initialise comment ?
et le chr(34) c'est quoi ?
mais cela peut attendre demain
A+
Ils ne savaient pas que c'était impossible ... du coup ils l'ont fait (Mark Twain)
n'oubliez pas de si les messages vous aide ou sont pertinents et de mettre quand cela est !
Oui j'ai mis en commentaire le début de la macro qui gère l'ouverture du fichier L est
Chr(34) c'est les doubles cote ["]
Code : Sélectionner tout - Visualiser dans une fenêtre à part dim L as long
Et vue que là je suis dans les transports en commun!
Oui certes j'ai bien vu la déclaration c'est l'initialisation que je ne vois pas
Je suis peut-être un et je suis peut-être bigleux mais je vois pas et donc je pige pas
désolé
A+
Ils ne savaient pas que c'était impossible ... du coup ils l'ont fait (Mark Twain)
n'oubliez pas de si les messages vous aide ou sont pertinents et de mettre quand cela est !
Puisque le Long non initialisé est égal à 0, c'est peut être volontaire de ne pas l'avoir initialisé
par défaut dim as long est égale à Zéro
en vb.net en revanche! dim L as long=0
Bonjour,
@Igloobel: bien vu pour les balises, je n'y avais pas pensé. J'espère que mon logiciel de destination prendra en compte cette écriture.
@rdurupt: merci pour le code, je vais essayer de traiter le fichier et de l'utiliser dans mon logiciel d'analyse pour voir si il prend en compte des caractères mis en forme. Donc que fais excel avec ces balises avec ce code? Il les traduit en "exposant et indice"?
Merci pour vos réponses et votre réactivité.
ElsassBlitz.
Bonjour,
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103 #If Win64 Then Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Declare PtrSafe Function CloseClipboard Lib "User32" () As Long Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long #Else Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Declare Function CloseClipboard Lib "User32" () As Long Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long Declare Function EmptyClipboard Lib "User32" () As Long Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long #End If Public Const GHND = &H42 Public Const CF_TEXT = 1 Public Const MAXSIZE = 4096 Sub test() 'Dim Fichier As String 'Dim Txt 'Dim Ligne 'Dim L As Long 'Fichier = "c:\ExportOpenSourceApp.txt" 'Set FSO = CreateObject("Scripting.FileSystemObject") 'If FSO.GetFile(Fichier).Size = 0 Then Exit Sub 'Set oTxt = FSO.OpenTextFile(Fichier, 1) 'Txt = oTxt.ReadAll 'oTxt.Close 'Set oTxt = Nothing 'Set FSO = Nothing Txt = "C2C Number,Molecular Weight,Molecular Formula,Chemical Name," Txt = Txt & vbCrLf & """AAA"",""428.709"",""<html>C<sub>78</sub>H<sub>52</sub>O</html>"",""<html>Cyclolol</html>""," Txt = Txt & vbCrLf & """BBB"",""255.249"",""<html>C<sub>120</sub>H<sub>110</sub>O<sub>15</sub></html>"",""<html>3,4',5,7-Tetralol(1+)</html>""," Txt = Txt & vbCrLf & """CCC"",""112.231"",""<html>C<sub>110</sub>H<sub>116</sub>1O</html>"",""<html>2-Methyl-6-methylene-2,7-lol</html>""," Txt = Txt & vbCrLf & """DDD"",""61.132"",""<html>C<sub>217</sub>H<sub>311</sub>O<sub>116</sub></html>"",""<html>3,3',4',5,7-Pentahydrlol; 3,7-Di-<i>O</i>-ß-<small>D</small>-glucolol</html>""," Txt = Txt & vbCrLf & """EEE"",""63.552"",""<html>C<sub>229</sub>H<sub>321</sub>O<sub>129</sub></html>"",""<html> 3,5-diglylol; Bis(monosaccharides), 3,5-Bis-(<i>O</i>-oxalyl-ß-<small>D</small>-glucolol)</html>""," Txt = Txt & vbCrLf & """FFF"",""53.442"",""<html>C<sub>139</sub>H<sub>331</sub>O<sub>139</sub></html>"",""<html>3,3',4',5,7-Pentalol; 3,7-Di-<i>O</i>-oxalyl-ß-<small>D</small>-glucolol</html>""," Txt = Txt & vbCrLf & """GGG"",""1810.246"",""<html>C<sub>141</sub>H<sub>146</sub>O<sub>5</sub></html>"",""<html>2-Ethyl-5-1,3-cyclolol</html>""," Txt = Split(Txt, vbCrLf) For I = 0 To UBound(Txt) If I = 0 Then txt2 = Split(Txt(I), ",") ActiveSheet.Range("A1:D1") = txt2 Else txt2 = Split(Txt(I), Chr(34) & "," & Chr(34)) ActiveSheet.Range("A1").Offset(L) = Replace(txt2(0), Chr(34), "") ActiveSheet.Range("B1").Offset(L) = Replace(txt2(1), Chr(34), "") ClipBoard_SetData Replace(txt2(2), Chr(34), "") ActiveSheet.Range("C1").Offset(L).PasteSpecial xlPasteAll ClipBoard_SetData Replace(txt2(3), Chr(34), "") ActiveSheet.Range("D1").Offset(L).PasteSpecial xlPasteAll End If L = L + 1 Next End Sub Function ClipBoard_SetData(MyString As String) Dim hGlobalMemory As Long, lpGlobalMemory As Long Dim hClipMemory As Long, X As Long ' Allocate moveable global memory. '------------------------------------------- hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1) ' Lock the block to get a far pointer ' to this memory. lpGlobalMemory = GlobalLock(hGlobalMemory) ' Copy the string to this global memory. lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString) ' Unlock the memory. If GlobalUnlock(hGlobalMemory) <> 0 Then MsgBox "Could not unlock memory location. Copy aborted." GoTo OutOfHere2 End If ' Open the Clipboard to copy data to. If OpenClipboard(0&) = 0 Then MsgBox "Could not open the Clipboard. Copy aborted." Exit Function End If ' Clear the Clipboard. X = EmptyClipboard() ' Copy the data to the Clipboard. hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) OutOfHere2: If CloseClipboard() = 0 Then MsgBox "Could not close Clipboard." End If End Function
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager