Importations de fichiers et tris

Version imprimable

12/07/2017, 18h19
miinaa

Importations de fichiers et tris

Bonjour à tous !

J'ai un fichier texte sous forme :

ID 1
nom
nom
nom
titre1
$
ID2
nom
nom
titre2
....etc

(fichier très gros)

Je voudrais importer ce fichier sous excel sous forme : (avec deux colonnes donc)

titre1 nom
titre1 nom
titre1 nom
titre2 nom
titre2 nom
....

J'ai essayé une ébauche de macro sur vba mais qui ne me donne pas grand chose.
Est ce que vous pourriez m'éclairer sur comment je dois m'y prendre ?
Merci :)
13/07/2017, 05h01
Invité

Citation:

Envoyé par miinaa

Bonjour,

En utilisant une boucle For I = X to 1 Step - 1, et en utilisant une variable de type string pour récupérer la chaîne si les 5 premiers caractères de la colonne A commencent par "Titre" (avec la fonction Mid). Puis en collant la valeur de la variable dans les cellules de la colonne B jusqu'à une nouvelle chaîne "Titre".
13/07/2017, 07h17
Invité

Bonjour,
Si l'exemple fourni est bien utile pour comprendre la philosophie du problème, il n'est pas parlant pour sa résolution!

Id égal. "Id = 1232" ou "la farandole des comptines"?
Nom égal "nom = chanteur" ou "chanteur"?
Titre égal "titre = promenons nous dans les bois" ou "promenons nous dans les bois"

Il y combien de lignes d'informations pour chaque Id?

En d'autres termes ou la réalité rejoint la fiction?

Ce qui serait intéressant également, est de savoir si c'est un vrai fichier texte (accès séquentiel) ou un fichier à accès direct?

A partir de quel logiciel ce fichier a été créé?

Il y a-t-il des caractères cabalistique après chaque espaces de texte?

Dans ton exemple après titre1 il y a "$" , après titre2 il y a "$"?
13/07/2017, 08h37
miinaa

Je vais détailler mon problème du coup :)

ID 2
aeroport
vol
aeronautique
$
ID 3
jazz
rock
rap
musique
$
...
ID 1000
or
diamant
bijoux
$

En gros, pour chaque ID (numeroté de 2 à 100), je voudrais avoir le dernier mot juste avant $ qui soit le nom et les autres mots entre ce ID et ce nom là qui soient des titres..
Il y a 1000 nom et pour chaque nom un nombre aléatoire de titres.
Plus précisément comme suivant :

nom1 titre titre
nom2 titre titre
...

Dans mon exemple, cela donne :

(en ligne)
aeronautique aeroport vol
musique jazz rock rap
bijoux or diamant

ou sinon

(en colonne que je prefererais avoir)
aeronautique musique bijoux
aeroport jazz or
vol rock diamant
rap

Merci.

seule la Sub test() t’intéresses!

Code:

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
104
105
106
107
108
109
110
111
112
113
#If VBA7 Then Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
 Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
 Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As Long
 Private Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
 Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
 Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
 Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
 Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As Long
 Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
#Else
 Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
 Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
 Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
 Private Declare Function CloseClipboard Lib "User32" () As Long
 Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
 Private Declare Function EmptyClipboard Lib "User32" () As Long
 Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
 Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
 Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
#End If
Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096
Sub test()
With CreateObject("ADODB.Connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MyRepertoire;Extended Properties=""Text;HDR=No;FMT=Delimited;"""
    ClipBoard_SetData Replace(.Execute("select * from [Importations de fichiers et tris#txt]").GetString(, , "©", vbTab), "$" & vbTab, vbCrLf)
    ActiveSheet.Range("A1").PasteSpecial xlPasteAll
    .Close
End With
End Sub
 
 
Function ClipBoard_GetData() As String
   Dim hClipMemory As Long
   Dim lpClipMemory As Long
   Dim MyString As String
   Dim RetVal As Long
 
   If OpenClipboard(0&) = 0 Then
      MsgBox "Cannot open Clipboard. Another app. may have it open"
      Exit Function
   End If
 
   ' Obtain the handle to the global memory
   ' block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then
      MsgBox "Could not allocate memory"
      GoTo OutOfHere
   End If
 
   ' Lock Clipboard memory so we can reference
   ' the actual data string.
   lpClipMemory = GlobalLock(hClipMemory)
 
   If Not IsNull(lpClipMemory) Then
      MyString = Space$(MAXSIZE)
      RetVal = lstrcpy(MyString, lpClipMemory)
      RetVal = GlobalUnlock(hClipMemory)
 
      ' Peel off the null terminating character.
      MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
   Else
      MsgBox "Could not lock memory to copy string from."
   End If
 
OutOfHere:
 
   RetVal = CloseClipboard()
   ClipBoard_GetData = MyString
 
End Function
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

ID 2	aeroport	vol	aeronautique
ID 3	jazz	rock	rap	musique
ID 1000	or	diamant	bijoux