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
| Option Compare Database
Sub ReadData()
Dim i As Long, j As Long, t As Long
Dim val, OF As String
Dim xls As Excel.Application
Dim CarteDuPanneau As Integer
Dim Composant, Boitier, TypeFenetre, NFenetre, TypeErreur, Operateur As String
Dim x As Integer
Dim Lignes()
Dim Texte As String
Dim Plage As Range
Dim Flag As Boolean
DoCmd.SetWarnings False
PathName = "C:\Users\seyahi\Documents\Projet QUALITE\fichiers qualité\VISION\DocumentVISION\"
FileName = "ImportDonneeExt.xlsm"
Set xls = CreateObject("Excel.Application")
Set wbs = xls.Workbooks.Open(FileName:=PathName & FileName)
Set WS = wbs.Sheets("FichierAOI")
Set Plage = WS.Columns(2) 'plage de recherche
Der_ligne = WS.Cells(Rows.Count, "B").End(xlUp).Row
j = 1
i = 1
Texte = ":" 'expression cherchée
'si fonction retourne Vrai = expression trouvée dans la plage
Flag = Find_Next(Plage, Texte, Lignes()) 'appel de la fonction
For j = 1 To Der_ligne
If Flag Then
For t = LBound(Lignes) To UBound(Lignes)
Debug.Print Lignes(j)
OF = WS.Cells(Lignes(j), "C").Value
Debug.Print OF
j = t + 1
If WS.Cells(j, 1) = "" Then
val = WS.Cells(j, 2).Value
CarteDuPanneau = Right(val, 1)
Composant = Left(val, 4)
Boitier = WS.Cells(j, 3)
TypeFenetre = WS.Cells(j, 4)
NFenetre = WS.Cells(j, 5)
TypeErreur = WS.Cells(j, 7)
Operateur = WS.Cells(j, 8)
'DoCmd.RunSQL "INSERT INTO DATA (OF, CarteDuPanneau, Composant, Boitier, TypeFenetre, NFenetre, TypeErreur, Operateur) VALUES ('" & OF & "', '" & CarteDuPanneau & "','" & Composant & "','" & Boitier & "','" & TypeFenetre & "','" & NFenetre & "','" & TypeErreur & "','" & Operateur & "')"
End If
Next t
End If
'MsgBox "L'expression : " & Texte & " n'a pas été trouvée dans la plage : " & Plage.Address
Next j
wbs.Close
DoCmd.SetWarnings True
End Sub
Function Find_Next(Rng As Range, Texte As String, Tbl()) As Boolean
Dim Nbre As Integer
Dim Lig As Long, Cptr As Long
Dim zone As Range
PathName = "C:\Users\seyahi\Documents\Projet QUALITE\fichiers qualité\VISION\DocumentVISION\"
FileName = "ImportDonneeExt.xlsm"
Set xls = CreateObject("Excel.Application")
Set wbs = xls.Workbooks.Open(FileName:=PathName & FileName)
Set WS = wbs.Sheets("FichierAOI")
Set zone = WS.Columns(2)
'Nbre = Application.WorksheetFunction.CountIf(Rng, Texte)
Nbre = xls.WorksheetFunction.CountIf(WS.Range("J:J"), "0")
If Nbre > 0 Then
ReDim Tbl(Nbre)
Lig = 1
For Cptr = 1 To Nbre
Lig = zone.Find(Texte, WS.Cells(Lig, Rng.Column), xlValues).Row
Tbl(Cptr) = Lig
Debug.Print Tbl(Cptr)
Next
Else
GoTo Absent
End If
Find_Next = True
Exit Function
Absent:
Find_Next = False
End Function |
Créer une base multidimensionnelle
Répondre avec citation
Envoyé par ClaudeLELOUP
Partager