Discussion :

[djilali22]

Salut tout le monde
Voila ;j'ai 2 fichiers de differtents dimensions que j'ai place dans des tableaux
jusqu'a la tout va bien.
Mon probleme comment cree un troisieme tableau a partir de ces 2 fichiers qui ont un champ commun et lister les doublons de ce dernier tableau
voici mon code

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
Private Sub Command1_Click()
Dim xdata(20000, 14)
Dim sdata(1500, 10)
Dim Textline1
Dim Textline2
 
Open file1 For Input As #1
sn = 1
While Not EOF(1)
sn = sn + 1
Line Input #1, Textline2
sdata(sn, 1) = Mid$(Textline2, 2, 3)      
sdata(sn, 2) = (Mid$(Textline2, 20, 4))     
sdata(sn, 3) = Val(Mid$(Textline2, 26, 1))    
sdata(sn, 4) = Mid$(Textline2, 27, 2)          
sdata(sn, 5) = Val(Mid$(Textline2, 48, 8))    
sdata(sn, 6) = Val(Mid$(Textline2, 57, 9))     
sdata(sn, 7) = Val(Mid$(Textline2, 66, 6))     
sdata(sn, 8) = Val(Mid$(Textline2, 72, 3))     
sdata(sn, 9) = (Mid$(Textline2, 75, 6))        
sdata(sn, 10) = sdata(sn, 1) * 10000 + sdata(sn, 2)
scheck = sdata(sn, 1) * 10000 + sdata(sn, 2)
Wend
MsgBox "Nb de ligne: " & sn
Close 1
 
Open file2 For Input As #2
xn = 1
While Not EOF(2)
xn = xn + 1
Line Input #2, Textline1
xdata(xn, 1) = Val(Mid$(Textline1, 2, 3))        
xdata(xn, 2) = Val(Mid$(Textline1, 8, 4))        
xdata(xn, 3) = Val(Mid$(Textline1, 12, 1))       '
xdata(xn, 4) = Val(Mid$(Textline1, 13, 1))       '
xdata(xn, 5) = Val(Mid$(Textline1, 14, 4))       ' 
xdata(xn, 6) = Val(Mid$(Textline1, 32, 4))       ' 
xdata(xn, 7) = Val(Mid$(Textline1, 38, 1))       ' 
xdata(xn, 8) = Val(Mid$(Textline1, 39, 4))       '
xdata(xn, 9) = Val(Mid$(Textline1, 43, 4))       '
xdata(xn, 10) = Val(Mid$(Textline1, 47, 1))      '
xdata(xn, 11) = Val(Mid$(Textline1, 48, 4))      '
xdata(xn, 12) = Val(Mid$(Textline1, 67, 4))      ' 
xdata(xn, 13) = Val(Mid$(Textline1, 76, 4))      ' 
xdata(xn, 14) = Val(Mid$(Textline1, 80, 1))      '
xcheck = xdata(xn, 5) * 1000 + xdata(xn, 6)
Wend
MsgBox "Nb de ligne: " & xn
Close 2

'

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Open file3 For Output As #3
 For i = 1 To xn
   For j = 1 To sn
      
If sdata(j, 1) * 10000 + sdata(j, 2) = xdata(i, 5) * 10000 + xdata(i, 6) Then
out$ = xdata(j,1) + space(5) + sdata(j,1) + sdata(j,2)
print #3,out$
Debug.Print out$
End If
   Next j
   Next i
Close #3

End Sub

ce qui est en rouge est le probleme
Merci d'avance

[ProgElecT]

Salut
Pour te proposer une solution là mieux adaptée, il nous faudrait voir la structure de 2 lignes de ton fichier N°1 et 2, cela nous aiderait bien, car il me semble que le remplis des tableaux (ou collections) devrait pouvoir ce faire plus rapidement et la recherche de doublons par là même aussi.
Lors de la lecture de
fichier N°1 : scheck = sdata(sn, 1) * 1000 + sdata(sn, 1)
et
fichier N°2 : xcheck = xdata(xn, 5) * 1000 + xdata(xn, 6)
scheck et xcheck sont les doublons possible ?
Je pourrai te proposer, comme bien d’autres, une solution, mais elle ne serait pas des plus performante, la connaissance de la structure de tes lignes de fichier, pour moi semble indispensable.
A+

[djilali22]

Merci ProqElect
voici un morceau de la structure des fichiers
fichier 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
S346.0             1354.01               0     745910.1 3506361.4 626.8212071330
S346.0             1354.01               0     745910.1 3506361.4 626.8212071812
S346.0             1353.01               0     745913.0 3506364.4 627.0212072214
S350.0             1354.01               0     745475.5 3506758.2 621.0212072622
S346.0             1352.01               0     745950.9 3506399.6 629.7212072750
S350.0             1353.01               0     745507.2 3506804.1 620.2212072830
S346.0             1351.01               0     745998.8 3506447.0 632.5212073000
S350.0             1352.01               0     745547.5 3506845.3 618.9212073021
S346.0             1350.01               0     746039.9 3506486.3 634.3212073148
S350.0             1351.01               0     745593.4 3506889.2 619.2212073209
S346.0             1349.01               0     746083.3 3506527.3 634.1212073332
S350.0             1350.01               0     745633.3 3506927.9 620.5212073354

fichier 2

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
X31    160210346.0             1354.01   1  801107                 1821    19001
X31    160210346.0             1354.01  81 1601109                 1821    19001
X31    160210346.0             1354.01 161 2401111                 1821    19001
X31    160210346.0             1354.01 241 3201113                 1821    19001
X31    160210346.0             1354.01 321 4001115                 1821    19001
X31    160210346.0             1354.01 401 4701117                 1821    18901
X31    160210346.0             1354.01 471 5251119                 1821    18751
X31    160210346.0             1354.01 526 5701121                 1821    18651
X31    160210346.0             1354.01 571 6001123                 1821    18501
X31    160210346.0             1354.01 601 6151125                 1821    18351
X31    160210346.0             1354.01 616 6201127                 1821    18251
X31    160310346.0             1354.01   1  801107                 1821    19001
X31    160310346.0             1354.01  81 1601109                 1821    19001
X31    160310346.0             1354.01 161 2401111                 1821    19001
X31    160310346.0             1354.01 241 3201113                 1821    19001
X31    160310346.0             1354.01 321 4001115                 1821    19001
X31    160310346.0             1354.01 401 4701117                 1821    18901
X31    160310346.0             1354.01 471 5251119                 1821    18751
X31    160310346.0             1354.01 526 5701121                 1821    18651
X31    160310346.0             1354.01 571 6001123                 1821    18501
X31    160310346.0             1354.01 601 6151125                 1821    18351
X31    160310346.0             1354.01 616 6201127                 1821    18251
X31    160410346.0             1353.01   1  801107                  1821    19001
X31    160410346.0             1353.01  81 1601109                 1821    19001
X31    160410346.0             1353.01 161 2401111                 1821    19001
X31    160410346.0             1353.01 241 3201113                 1821    19001
X31    160410346.0             1353.01 321 4001115                 1821    19001
X31    160410346.0             1353.01 401 4701117                 1821    18901
X31    160410346.0             1353.01 471 5251119                 1821    18751
X31    160410346.0             1353.01 526 5701121                 1821    18651
X31    160410346.0             1353.01 571 6001123                 1821    18501
X31    160410346.0             1353.01 601 6151125                 1821    18351
X31    160410346.0             1353.01 616 6201127                 1821    18251

[zazaraignée]

Salut

Je me suis permis d'ajouter les balises code à tes listings de fichiers. Ça donne une couleur un peu bizarre, j'en conviens d'avance, mais c'est surtout pour la chasse fixe. (C'est l'automne, la saison de la chasse... )

Ceci m'a permis de voir qu'une ligne de données dépasse des autres...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
X31    160310346.0             1354.01 616 6201127                 1821    18251
X31    160410346.0             1353.01   1  801107                  1821    19001
X31    160410346.0             1353.01  81 1601109                 1821    19001

Serait-ce l'origine du problème ? À moins qu'un espace inopportun ne se soit ajouté en recopiant le contenu de tes fichier dans ton message...

[ProgElecT]

Pas de panique, le code semble un peu long mais en fait il ce répète, de plus il n’est pas encor optimisé, certaine chose pouvant être faite dans une routine, et d’autre ne devant pas passer par des variables intermédiaires.
Ton code d’extraction avec Mid(….) ne semble pas possible étant donné que tes nombres ne sont pas forcément de même longueur dans le fichier N°2.
Du coup je ne parviens pas à déterminer les données entrant dans le calcul en vue de comparaison.
Voici un code, il ne renvoi pas de doublon, mais les données récupérées ne sont peut être pas les bonnes, ou les lignes fournis ne sont pas assez nombreuses, et il n’existe pas de doublons dans ces lignes.

Sur un Form un ListBox nommé "ListDoublons"

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Option Explicit
Private Type MultipleTableau
 LeData() As String
End Type
Dim MonTableau1() As MultipleTableau
Dim MonTableau2() As MultipleTableau
 
Dim ChemNomFichier1 As String
Dim ChemNomFichier2 As String
Dim ChemNomFichier3 As String
Dim Msg$
Dim NumFich As Integer
Dim NbrLgn As Integer, NbrCln As Integer
Dim T As Integer, U As Integer
Dim ValCompar As String
 
Private Sub Form_Load()
ChemNomFichier1 = "C:\PersoFrancis\FichierN1.txt"
Msg$ = ""
NumFich = FreeFile
Open ChemNomFichier1 For Input As #NumFich
Msg$ = Input(FileLen(ChemNomFichier1), NumFich)
Close #NumFich
 
'variables intermediaires à 1 indice, servant à construire le tableau "MonTableau1" a 2 indices
Dim DecoupeContenuLg() As String
Dim DecoupeContenuCl() As String
'création du tableau "DecoupeContenuLg", pour 1° indice (Ligne) du tableau "MonTableau1"
DecoupeContenuLg = Split(Msg$, vbCrLf)
'création du tableau "DecoupeContenuCl", pour 2° indice (colonne, "LeData") du tableau "MonTableau1"
DecoupeContenuCl = Split(DecoupeContenuLg(0), " ")
'recuperation du Nbr de lignes et Nbr de colonne
NbrLgn = UBound(DecoupeContenuLg) - 1 '(-1 car le fichier ce termine par une ligne vierge)
NbrCln = UBound(DecoupeContenuCl)
 
'maintenant que le Nbr de lignes et le Nbr de colonnes est connu
'dimensionnement de la variable tableau "MonTableau1"
ReDim MonTableau1(NbrLgn)
'on remplis MonTableau1
For T = 0 To NbrLgn
 'recuperation de chaque colonne de la ligne
 DecoupeContenuCl = Split(DecoupeContenuLg(T), " ")
 For U = 0 To NbrCln
  ReDim Preserve MonTableau1(T).LeData(U)
  If U = 0 Then
   'condition, le data de la ligne lut doit toujours ne contenir qu'une lettre à gauche
   MonTableau1(T).LeData(U) = Val(Right(DecoupeContenuCl(U), Len(DecoupeContenuCl(U)) - 1))
   Else
   MonTableau1(T).LeData(U) = DecoupeContenuCl(U)
  End If
 Next U
 'ici on ajoute l'argument (par calcul) qui risque d'être en doublon, pour comparaison par la suite
 ReDim Preserve MonTableau1(T).LeData(NbrCln + 1)
 'sdata(j, 1) * 10000 + sdata(j, 2)*** je décale vu que le premier indice = 0
 MonTableau1(T).LeData(NbrCln + 1) = (Val(MonTableau1(T).LeData(0)) * 10000) + Val(MonTableau1(T).LeData(1))
Next T
 
'pour debug
'For T = 0 To NbrLgn
' For U = 0 To NbrCln + 1
'  Debug.Print MonTableau1(T).LeData(U)
' Next U
'Next T
'passage au 2° fichier
ChemNomFichier2 = "C:\PersoFrancis\FichierN2.txt"
Msg$ = ""
NumFich = FreeFile
Open ChemNomFichier2 For Input As #NumFich
Msg$ = Input(FileLen(ChemNomFichier1), NumFich)
Close #NumFich
'création du tableau "DecoupeContenuLg", pour 1° indice (Ligne) du tableau "MonTableau2"
DecoupeContenuLg = Split(Msg$, vbCrLf)
'création du tableau "DecoupeContenuCl", pour 2° indice (colonne, "LeData") du tableau "MonTableau2"
DecoupeContenuCl = Split(DecoupeContenuLg(0), " ")
'recuperation du Nbr de lignes et Nbr de colonne
NbrLgn = UBound(DecoupeContenuLg) - 1 '(-1 car le fichier ce termine par une ligne vierge)
NbrCln = UBound(DecoupeContenuCl)
 
'maintenant que le Nbr de lignes et le Nbr de colonnes est connu
'dimensionnement de la variable tableau "MonTableau2"
ReDim MonTableau2(NbrLgn)
'on remplis MonTableau2
For T = 0 To NbrLgn
 'recuperation de chaque colonne de la ligne
 DecoupeContenuCl = Split(DecoupeContenuLg(T), " ")
 For U = 0 To NbrCln
  ReDim Preserve MonTableau2(T).LeData(U)
  If U = 0 Then
   'condition, le data de la ligne lut doit toujours ne contenir qu'une lettre à gauche
   MonTableau2(T).LeData(U) = Val(Right(DecoupeContenuCl(U), Len(DecoupeContenuCl(U)) - 1))
   Else
   MonTableau2(T).LeData(U) = DecoupeContenuCl(U)
  End If
 Next U
 'ici on ajoute l'argument qui risque d'être en doublon, pour comparaison par la suite
 ReDim Preserve MonTableau2(T).LeData(NbrCln + 1)
 'xdata(i, 5) * 10000 + xdata(i, 6)*** je décale vu que le premier indice = 0
 MonTableau2(T).LeData(NbrCln + 1) = (Val(MonTableau2(T).LeData(4)) * 10000) + Val(MonTableau2(T).LeData(5))
Next T
'pour debug
'For T = 0 To NbrLgn
' For U = 0 To NbrCln + 1
'  Debug.Print MonTableau2(T).LeData(U)
' Next U
'Next T
 
'rechercher les doublons, et les consigner dans FichierN3.txt
ListDoublons.Clear
For T = 0 To UBound(MonTableau1)
 ValCompar = MonTableau1(T).LeData(UBound(MonTableau1(T).LeData, 1))
 For U = 0 To UBound(MonTableau2)
  If ValCompar = MonTableau2(U).LeData(UBound(MonTableau2(U).LeData, 1)) Then
   ListDoublons.AddItem "Fch1,lgn " & CStr(T + 1) & ", Fch2,lgn " & CStr(U + 1)
  End If
 Next U
Next T
'reste a faire, on verra sa plus tard
'ChemNomFichier3 = "C:\PersoFrancis\FichierN3.txt"
End Sub

A+

Bien vu zazaraignée, moi c'est quand je n'est pas trouvé de doublons que je me suis repenché sur les lignes de données fournis

[djilali22]

Merci zazaraignee
Merci preselect : ton code est très professionnelle ca marche sans erreur en changement seulement Msg$ = Input(FileLen(ChemNomFichier2), Nomfich)
a la place chemnomfichier1.
j'ajoute quelques precisions :
le nombre de colonne des 2 fichiers est de 80 fixe.
le critere de comparaison pour le 1er fichier : contenation du 5 derniers chiffres de la 1ere colonne + les 4 premiers chiffres de la 2ème colonne.
pour le 2ème fichier : contenation des 5 derniers chiffres de la 2eme colonne + les 4 premiers chiffres de la 3ème colonne

[ProgElecT]

Je n'ai jamais été autant derangé durant une astreinte (le pro) .

Merci preselect

ProgElecT
Sur un Form, 2 ListBoxs, nommé "ListDoublons" et "ListLgns", un Label nommé "Label1" , pas plus, le reste est fait par le code

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Option Explicit
 
Private Type MultipleTableau
 LeData(2) As String
End Type
Dim MonTableau1() As MultipleTableau
Dim MonTableau2() As MultipleTableau
 
Dim NumFich As Integer
Dim ChemNomFichier1 As String
Dim ChemNomFichier2 As String
Dim ChemNomFichier3 As String
Dim DecoupeContenuLg() As String
Dim DecoupeContenuCl() As String
Dim NbrLgn As Integer
Dim Msg$
Dim T As Integer, U As Integer
 
Private Sub Form_Load()
Me.Height = Screen.Height - 600: Me.Width = 5415
Me.Top = 0: Me.Left = 0:
ListDoublons.Move 30, 30, 2205, Me.ScaleHeight - 60
ListLgns.Move 2310, 30, 855, 1425
Label1.Move 2310, 1560, 2925, 2925
 
ChemNomFichier1 = "C:\PersoFrancis\FichierN1.txt"
Msg$ = ""
NumFich = FreeFile
Open ChemNomFichier1 For Input As #NumFich
Msg$ = Input(FileLen(ChemNomFichier1), NumFich)
Close #NumFich
 
'variables intermediaires à 1 indice, servant à construire le tableau "MonTableau1" a 2 indices
'création du tableau "DecoupeContenuLg", pour 1° indice (Ligne) du tableau "MonTableau1"
DecoupeContenuLg = Split(Msg$, vbCrLf)
'création du tableau "DecoupeContenuCl", pour 2° indice (colonne, "LeData") du tableau "MonTableau1"
'recuperation du Nbr de lignes
NbrLgn = UBound(DecoupeContenuLg) - 1 '(-1 car le fichier ce termine par une ligne vierge)
 
'maintenant que le Nbr de lignes
'dimensionnement de la variable tableau "MonTableau1"
ReDim MonTableau1(NbrLgn) '11
'on remplis MonTableau1
For T = 0 To NbrLgn
 'recuperation de chaque colonne de la ligne
 DecoupeContenuCl = Split(DecoupeContenuLg(T), " ")
 'contenation des 5 derniers chiffres de la 1ere colonne
 '+ les 4 premiers chiffres de la 2ème colonne
 DecoupeContenuCl(0) = Replace(DecoupeContenuCl(0), ".", ",")
 MonTableau1(T).LeData(0) = Int(Right(DecoupeContenuCl(0), 5))
 DecoupeContenuCl(1) = Replace(DecoupeContenuCl(1), ".", ",")
 MonTableau1(T).LeData(1) = Int(Left(DecoupeContenuCl(1), 4))
 MonTableau1(T).LeData(2) = MonTableau1(T).LeData(0) & MonTableau1(T).LeData(1)
Next T
'pour debug
'For T = 0 To NbrLgn
' For U = 0 To 2
'  Debug.Print MonTableau1(T).LeData(U)
' Next U
'Next T
ChemNomFichier2 = "C:\PersoFrancis\FichierN2.txt"
Msg$ = ""
NumFich = FreeFile
Open ChemNomFichier2 For Input As #NumFich
Msg$ = Input(FileLen(ChemNomFichier2), NumFich)
Close #NumFich
DecoupeContenuLg = Split(Msg$, vbCrLf)
NbrLgn = UBound(DecoupeContenuLg) - 1
ReDim MonTableau2(NbrLgn) '32
For T = 0 To NbrLgn
 'recuperation de chaque colonne de la ligne
 DecoupeContenuCl = Split(DecoupeContenuLg(T), " ")
 '5 derniers chiffres de la 2eme colonne
 '+ les 4 premiers chiffres de la 3ème colonne
 DecoupeContenuCl(1) = Replace(DecoupeContenuCl(1), ".", ",")
 MonTableau2(T).LeData(0) = Int(Right(DecoupeContenuCl(1), 5))
 DecoupeContenuCl(1) = Replace(DecoupeContenuCl(1), ".", ",")
 MonTableau2(T).LeData(1) = Int(Left(DecoupeContenuCl(2), 4))
 MonTableau2(T).LeData(2) = MonTableau2(T).LeData(0) & MonTableau2(T).LeData(1)
Next T
'pour debug
'For T = 0 To NbrLgn
' For U = 0 To 2
'  Debug.Print MonTableau2(T).LeData(U)
' Next U
'Next T
 
'recherche les doublons
ListDoublons.Clear: ListLgns.Clear
For T = 0 To UBound(MonTableau1)
 For U = 0 To UBound(MonTableau2)
  If MonTableau1(T).LeData(2) = MonTableau2(U).LeData(2) Then
   ListDoublons.AddItem "Fch1,lgn " & CStr(T + 1) & ", Fch2,lgn " & CStr(U + 1)
   VerifNumLigne CStr(T + 1)
  End If
 Next U
Next T
 
If ListDoublons.ListCount >= 1 Then
 Me.Caption = "Nbr de doublons " & CStr(ListDoublons.ListCount)
 Label1 = "Dans le Fichier N°1 les lignes" & vbCrLf
 'affiche les doublons
 For T = 0 To ListLgns.ListCount - 1
  Label1 = Label1 & CStr(ListLgns.List(T)) & ", "
 Next T
 Label1 = Label1 & vbCrLf & "crée des doublons dans le fichier N°2"
 Else
 Label1 = ""
End If
End Sub
 
Public Sub VerifNumLigne(NumLgn As String)
Dim V As Integer
Dim Existe As Boolean
Existe = False
For V = 0 To ListLgns.ListCount - 1
 If ListLgns.List(T) = NumLgn Then Existe = True: Exit For
Next V
If Existe = False Then ListLgns.AddItem NumLgn
End Sub

Resultat, pour les lignes fournies,

Dans le fichier N°1 les lignes
1, 2, 3,
crée des doublons dans le fichier N°2

pour le ListDoublons, a decouvrir par toi même, ce qui te permettra d'adapter au mieux.
Ne sachant pas ton niveau, de toute façons MSDN (chargable sur ce site) te donneras pas mal d'infos sur les divers fonctions utilisées.
A+

[djilali22]

bonjour
merci pour le code,j'avais a faire des modifications necessaires car le separateur des chaines est un melange entre espace et tab;
a l'origine mes fichiers sont au format unix que j'ai convertis en DOS.
Et aussi j'ai mal formule mon probleme.je m'excuse
Je cherche les doublons parmis les valeurs que j'ai contenate et sortir une liste des doublons avec la valeur de la colonne correspondante du deuxieme fichier.