Optimisation Recherche base de données
Résolu/Fermé
DrFoZz
Messages postés
8
Date d'inscription
vendredi 29 août 2014
Statut
Membre
Dernière intervention
8 septembre 2014
-
8 sept. 2014 à 10:01
DrFoZz Messages postés 8 Date d'inscription vendredi 29 août 2014 Statut Membre Dernière intervention 8 septembre 2014 - 8 sept. 2014 à 13:16
DrFoZz Messages postés 8 Date d'inscription vendredi 29 août 2014 Statut Membre Dernière intervention 8 septembre 2014 - 8 sept. 2014 à 13:16
A voir également:
- Optimisation Recherche base de données
- Recherche musique - Guide
- Recherche par image - Guide
- Exemple base de données access à télécharger gratuit - Forum Access
- Formules excel de base - Guide
- Exemple base de données Access de gestion ✓ - Forum Logiciels
2 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
8 sept. 2014 à 10:25
8 sept. 2014 à 10:25
Bonjour,
Forcément, en procédant de la sorte, à chaque appel de fonction tu reconstruit tes tableaux...
Donc, à chaque boucle, chaque test tes fonctions se relancent...
Construit donc tes variables tableaux au début de ta procédure principale :
Je n'ai pas testé ce code, mais c'est pour que tu vois le principe.
Forcément, en procédant de la sorte, à chaque appel de fonction tu reconstruit tes tableaux...
Donc, à chaque boucle, chaque test tes fonctions se relancent...
Construit donc tes variables tableaux au début de ta procédure principale :
Sub recherche_ITEM() 'Programme de recherché
Dim tab_ITEM() As Variant, tab_BOM As Variant
Dim lastRow As Long, i As Long, j As Long
'-----------tab_ITEM
Application.ScreenUpdating = False
Windows("ITEM_Compilation_test.xlsx").Activate
lastRow = Worksheets("Compilation ITEM").Range("A" & Rows.Count).End(xlUp).Row - 1
ReDim tab_ITEM(lastRow, 2)
For i = 0 To UBound(tab1)
tab_ITEM(i, 0) = Worksheets("Compilation ITEM").Range("A" & i + 2)
tab_ITEM(i, 1) = Worksheets("Compilation ITEM").Range("B" & i + 2)
tab_ITEM(i, 2) = Worksheets("Compilation ITEM").Range("K" & i + 2)
Next i
ThisWorkbook.Worksheets("Validation BOM").Activate
'-----------tab_BOM
ThisWorkbook.Activate '===> A VOIR
lastRow = Range("B" & Rows.Count).End(xlUp).Row - 2
ReDim tab_BOM(lastRow, 2)
For i = 0 To UBound(tab1)
tab_BOM(i, 0) = ThisWorkbook.Worksheets("Validation BOM").Range("C" & i + 3)
tab_BOM(i, 1) = ThisWorkbook.Worksheets("Validation BOM").Range("D" & i + 3)
tab_BOM(i, 2) = ThisWorkbook.Worksheets("Validation BOM").Range("E" & i + 3)
Next i
For i = 0 To UBound(tab_BOM)
For j = 0 To UBound(tab_ITEM)
If (tab_BOM(i, 0)) = (tab_ITEM(j, 0)) Then Exit For
Next j
If j > UBound(tab_ITEM) Then
Call CopieCellule_nonExist(i)
Else
Call CopieCellule_Exist(j + 2, i)
End If
Next i
End Sub
Je n'ai pas testé ce code, mais c'est pour que tu vois le principe.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
8 sept. 2014 à 12:33
8 sept. 2014 à 12:33
Oui. Suffit de modifier ta variable tableau tab_ITEM dans tes fonctions Sub CopieCellule_nonExist et Sub CopieCellule_Exist, de le redimensionner dans ces Sub et d'y enregistrer tes nouvelles valeurs.
Le plus simple, dans ce cas, est de déclarer ta variable tableau tab_ITEM() en entête de module. Comme cela elle sera accessible de partout dans le module :
Le plus simple, dans ce cas, est de déclarer ta variable tableau tab_ITEM() en entête de module. Comme cela elle sera accessible de partout dans le module :
Option Explicit Dim tab_ITEM() As Variant Sub recherche_ITEM() 'Programme de recherché Dim tab_BOM As Variant Dim lastRow As Long, i As Long, j As Long 'etc...
DrFoZz
Messages postés
8
Date d'inscription
vendredi 29 août 2014
Statut
Membre
Dernière intervention
8 septembre 2014
8 sept. 2014 à 13:16
8 sept. 2014 à 13:16
Merci beaucoup, ça marche :D
J'ai fait comme t'as dit au début, intégrer les fonctions tableaux à mon main...et j'ai créé un nouveau tableau qui me regarde les doublons...ça m'évite de recréer ma DataBase à chaque fois. Je compile tout simplement mon tableau sans doublons à la fin de l'opération.
L'avantage c'est que ça me garde une trace des ligne ajoutée....et c'est nettement plus rapide!!!!
Merci beaucoup Franck ;D
SI ça interesse qq'un:
J'ai fait comme t'as dit au début, intégrer les fonctions tableaux à mon main...et j'ai créé un nouveau tableau qui me regarde les doublons...ça m'évite de recréer ma DataBase à chaque fois. Je compile tout simplement mon tableau sans doublons à la fin de l'opération.
L'avantage c'est que ça me garde une trace des ligne ajoutée....et c'est nettement plus rapide!!!!
Merci beaucoup Franck ;D
SI ça interesse qq'un:
Sub recherche_ITEM()
Dim tab_BOM() As Variant
Dim tab_ITEM() As Variant
Application.ScreenUpdating = False
'Création d'un tableau List BOM
lastRow = Range("A" & Rows.Count).End(xlUp).Row
ReDim tab_BOM(lastRow, 2)
For i = 0 To UBound(tab_BOM)
tab_BOM(i, 0) = Range("A" & i + 3)
tab_BOM(i, 1) = Range("B" & i + 3)
tab_BOM(i, 2) = Range("C" & i + 3)
Next i
'Création d'un tableau ITEM compilation
lastRow = Sheets("Compilation ITEM").Range("A" & Rows.Count).End(xlUp).Row
ReDim tab_ITEM(lastRow, 2)
For i = 0 To UBound(tab_ITEM)
tab_ITEM(i, 0) = Sheets("Compilation ITEM").Range("A" & i + 2)
tab_ITEM(i, 1) = Sheets("Compilation ITEM").Range("B" & i + 2)
tab_ITEM(i, 2) = Sheets("Compilation ITEM").Range("K" & i + 2)
Next i
'Comparaison entre la BOM et la Compilation ITEM
For i = 0 To UBound(tab_BOM)
For j = 0 To UBound(tab_ITEM)
If (tab_BOM(i, 0)) = (tab_ITEM(j, 0)) Then Exit For
Next j
'Si pas trouvé de correspondance
If j > UBound(tab_ITEM) Then
'Création d'un tableau des valeurs à compiler (vérificatiion doublons)
tab_double = Sheets("A compiler").UsedRange.Columns("A:C").Value
For k = 1 To UBound(tab_double)
If (tab_BOM(i, 0)) = (tab_double(k, 1)) Then Exit For
Next k
'Si pas de correspondence, créer nouvelle ligne
If k > UBound(tab_double) Then
Call CopieCellule_nonExist(i)
End If
'Si trouvé, copier uniquement le statut
Else
Call CopieCellule_Exist(j + 2, i)
End If
Next i
End Sub
8 sept. 2014 à 11:01
8 sept. 2014 à 11:12