Sujet Précédent Sujet Suivant

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
Bonjour amis VBA,

j'ai un petit souci...surement dû à la lourdeur de mon code.

En mode step by step (debug)...tout fonctionne, mais quand je le lance normalement, Excel crash.
Je dois comparer une liste de pièces (environ 150 lignes) sur une base de données d'environ 5000 lignes qui se trouve dans un autre fichier. J'ai créé des fonctions pour faire deux tableau "virtuels" mais il me semble qu'au lieu d'accélérer le processus...ça le ralenti.

J'èspere avoir été assez claire.

Merci beaucoup pour votre aide :D

Voilà mon code: 
Sub recherche_ITEM() 'Programme de recherché

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

Function tab_ITEM() As Variant 'Rempli un tableau avec tout les ITEM de la DataBase ITEM_compilation_test.xlsx

Dim tab1() As Variant
Dim lastRow, i, j As Long

Application.ScreenUpdating = False
Windows("ITEM_Compilation_test.xlsx").Activate
lastRow = Worksheets("Compilation ITEM").Range("A" & Rows.Count).End(xlUp).Row - 1

ReDim tab1(lastRow, 2)

For i = 0 To UBound(tab1)
    tab1(i, 0) = Worksheets("Compilation ITEM").Range("A" & i + 2)
    tab1(i, 1) = Worksheets("Compilation ITEM").Range("B" & i + 2)
    tab1(i, 2) = Worksheets("Compilation ITEM").Range("K" & i + 2)
Next i
tab_ITEM = tab1
ThisWorkbook.Worksheets("Validation BOM").Activate
End Function

Function tab_BOM() As Variant 'Rempli un tableau avec tout les ITEM de la BOM

Dim tab1() As Variant
Dim lastRow, i As Long

Application.ScreenUpdating = False
ThisWorkbook.Activate
lastRow = Range("B" & Rows.Count).End(xlUp).Row - 2

ReDim tab1(lastRow, 2)

For i = 0 To UBound(tab1)
    tab1(i, 0) = ThisWorkbook.Worksheets("Validation BOM").Range("C" & i + 3)
    tab1(i, 1) = ThisWorkbook.Worksheets("Validation BOM").Range("D" & i + 3)
    tab1(i, 2) = ThisWorkbook.Worksheets("Validation BOM").Range("E" & i + 3)
Next i
tab_BOM = tab1
End Function

Sub CopieCellule_nonExist(Param1 As Variant) 'Si non existant, copie la ligne et la colle dans la DataBase

    Dim Départ, Destination
    Dim LigneDestination
    Set Destination = Workbooks("ITEM_Compilation_test.xlsx").Worksheets("Compilation ITEM") 'Feuille d'arrivée
    
    Destination.Activate
    LigneDestination = Destination.Range("A1048576").End(xlUp).Row + 1
    Destination.Range("A" & LigneDestination) = tab_BOM(Param1, 0)
    Destination.Range("B" & LigneDestination) = tab_BOM(Param1, 1)
    Destination.Range("K" & LigneDestination) = tab_BOM(Param1, 2)
    ThisWorkbook.Worksheets("Validation BOM").Activate   
End Sub

Sub CopieCellule_Exist(ligne_destination As Long, Param1 As Variant) 'Si existant, copie la cellule "statut" et la colle dans la DataBase

    Dim Départ, Destination
    Dim LigneDestination
    Set Destination = Workbooks("ITEM_Compilation_test.xlsx").Worksheets("Compilation ITEM") 'Feuille d'arrivée
    
    Destination.Activate
    LigneDestination = Destination.Range("A" & ligne_destination).Row
    Destination.Range("K" & LigneDestination) = tab_BOM(Param1, 2)
    ThisWorkbook.Worksheets("Validation BOM").Activate
End Sub

Sub recherche_fournisseur() 'Ouverture du fichier "ITEM compilation test.xlsx

On Error Resume Next ' Si une erreur est renvoyée, fichier non ouvert
     Windows("ITEM_Compilation_test.xlsx").Activate
If Err.Number <> 0 Then   'j'ouvre le fichier
     Workbooks.Open Filename:=("C:\Users\fza\Desktop\Processus_CFSI\ITEM_Compilation_test.xlsx")
        Windows("ITEM_Compilation_test.xlsx").Activate
End If
On Error GoTo 0
Call recherche_ITEM

End Sub

2 réponses

Réponse 1 / 2
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754
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 : 

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.
0
DrFoZz Messages postés 8 Date d'inscription vendredi 29 août 2014 Statut Membre Dernière intervention 8 septembre 2014
8 sept. 2014 à 11:01
Je vois le principe...le problème c'est que "tab_item" (la base de données) gonfle avec les nouvelles valeurs, pour éviter les doublons. Donc à chaque fois il doit refaire le tableau de 5000 lignes + la derniière ligne ajoutée.
0
DrFoZz Messages postés 8 Date d'inscription vendredi 29 août 2014 Statut Membre Dernière intervention 8 septembre 2014
8 sept. 2014 à 11:12
En faisant un tableau qui gonfle seulement avec les derniers ajouts...et qui se compile à la fin...ça pourrait marcher non?
0
Réponse 2 / 2
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754
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 : 

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...
0
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
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: 

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
0

Discussions similaires

TNT base de donnees vide!!
Angye25 -
Angye25 -

4 réponses
Nettoyer une base de données avec une liste
TOT127 -
TOT127 -

11 réponses
recherche à partir de la barre d'adresse
Sylviane -
Lulin -

11 réponses
mon téléphone ne reconnait plus sa base
TELEPHONaz -
baladur13 -

7 réponses
exemple base de données Access de gestion
jack -
sorosoro -

11 réponses