Re : Recherche base de données
Bonjour jp14,
Je viens d'insérer les macros dans mon fichier et tout fonctionne parfaitement, mais comme ma base de données contient plus de 4000 lignes et que je veux que la macro s'exécute sur tous les coûts de la ou les lignes modifiées dans la feuille "Calcul", la macro met du temps avant de terminer.
Voici ma programmation :
Private Sub Worksheet_Change(ByVal Target As Range)
'==========================================================================
'À faire à chaque fois qu'une donnée change dans la feuille.
'--------------------------------------------------------------------------
'booChangeActif : Variable qui est égale à "vrai" seulement si une autre fonction se déroule.
'inChange : Variable qui est égale à "vrai" seulement si la fonction Worksheet_Change
' se déroule.
'donnee : Cellules sélectionnées à analyser en loop.
'==========================================================================
Static inChange As Boolean
Dim donnee As Range
'S 'il y a une macro active, donc booChangeActif = true, alors la fonction
'Worksheet_Change() ne doit pas se dérouler.
If booChangeActif Or inChange Then
Exit Sub
End If
'Désactiver la fonction Worksheet_Change() pendant l'exécution de la présente macro.
inChange = True
For Each donnee In Target
'Inscrire le taux de l'indice lorsqu'il y a un coût d'inscrit.
If donnee.Row > 3 And _
donnee.Row < 11 Then '41 lignes dans mon fichier.
Call inscrireTaux(donnee)
End If
Next donnee
'Réactiveer la fonction WorkSheet_Change().
inChange = False
End Sub
Sub inscrireTaux(ByVal Target As Range)
'==========================================================================
'Inscrire le taux de l'indice.
'--------------------------------------------------------------------------
'==========================================================================
Dim cellZoneCoût As Range
Dim annee As Long
Dim ligne As Long
'Cette macro s'applique à toute les cellules de la zone "Zone"
For Each cellZoneCoût In Range("Zone") 'dans mon cas, la zone comprend 41 lignes et 8 colonnes.
'La macro ne s'applique que sur les lignes modifiées.
If cellZoneCoût.Row = Target.Row And _
Cells(cellZoneCoût.Row, Range("A1").Column).Value <> "" Then
'S'il n'y a aucun coût inscrit dans la zone "Zone", il n'y
'a aucun taux de l'indice.
If cellZoneCoût.Value = "" Then
Cells(cellZoneCoût.Row, _
cellZoneCoût.Column - 1).Value = ""
Else
'S'il s'agit de l'indice 99999, le taux est "S/O".
If Cells(cellZoneCoût.Row, _
Range("A1").Column).Value = 99999 Then
Cells(cellZoneCoût.Row, _
cellZoneCoût.Column - 1).Value = "S/O"
Else
'Sinon, la macro recherche d'abord l'année où le coût est inscrit.
annee = Year(Cells(Range("A1").Row + 1, _
cellZoneCoût.Column - 1).Value)
'Ensuite, elle recherche la ligne de la feuille "Taux" correspondant à l'année et
'l'indice recherché.
ligne = rechercheLigne("Taux", _
Array(annee, "A", _
Cells(cellZoneCoût.Row, _
Range("A1").Column).Value, _
"B"), 2, _
Range("A1").Row + 2)
'Avertir l'utilisateur de son erreur lorsqu'il inscrit des coûts dans
'un indice qui n'existe pas pour cette année.
If ligne = 0 Then
Call MsgBox("Vous avez saisi des coûts pour " _
& "l'indice " & Cells(cellZoneCoût.Row, _
Range("A1").Column).Value & vbCrLf _
& " alors que cet indice n'existe pas pour l'année " _
& annee & ".", vbInformation, "Indice inexistant")
Else
If Cells(cellZoneCoût.Row, _
Range("B1").Column).Value = _
"Provinciale" Then
Cells(cellZoneCoût.Row, _
cellZoneCoût.Column - 1).Value = _
sheets("Taux").Cells(ligne, _
Range("C1").Column).Value
Else
Cells(cellZoneCoût.Row, _
cellZoneCoût.Column - 1).Value = _
sheets("Taux").Cells(ligne, _
Range("D1").Column).Value
End If
End If
End If
End If
End If
Next cellZoneCoût
End Sub
Public Function rechercheLigne(ByVal feuilleRecherche As String, parametre As Variant, _
nbDonneeRecherche As Integer, ligneDepart As Long)
'==========================================================================
'Rechercher une ligne contenant un texte dans deux colonnes non adjacente.
'--------------------------------------------------------------------------
'feuilleRecherche : Feuille contenant les données à rechercher.
'parametre : Correspond aux données et la colonne recherchées.
'nbDonneeRecherche : Nombre de colonnes dans lesquelles il faut effectuer la recherche.
'ligneDepart : Première ligne de la recherche
'dataToRecherche : Représente la donnée créée à rechercher.
'dataCree : Représente les données créées parmi lesquelles la recherche s'effectue.
'noDonneeCree : Représente le numéro de l'information à insérer dans la donnée créée
' à rechercher.
'noDonneeRecherche : Représente le numéro de l'information à insérer dans les données
' créées parmi lesquelles la recherche s'effectue.
'indiceParametre : Représente le plus petit indice disponible pour la dimension
' indiquée du tableau Parametre.
'noLigneRecherche : Représente le numéro de la ligne recherchée.
'--------------------------------------------------------------------------
'==========================================================================
Dim dataToRecherche As String, dataCree As String
Dim noDonneeCree As Integer
Dim noDonneeRecherche As Long
Dim indiceParametre As Integer
'indiceParametre : Représente le plus petit indice disponible pour la dimension
' indiquée du tableau Parametre.
indiceParametre = LBound(parametre)
'Indiquer la feuille dans laquelle la recherche s'effectue.
With Sheets(feuilleRecherche)
'La ligne de départ doit nécessairement être inférieure à la dernière ligne de la
'feuilleRecherche où il y a des informations inscrites.
If ligneDepart <= .Range(parametre(indiceParametre + 1) & "65536").End(xlUp).Row Then
'S'il y plus d'une colonne, la macro assemble les données (concaténation).
If nbDonneeRecherche > 1 Then
'Création de la donnée recherchée en concaténant toutes les données à rechercher.
For noDonneeCree = 0 To nbDonneeRecherche * 2 - 1 Step 2
dataToRecherche = dataToRecherche & _
Trim(parametre(indiceParametre + noDonneeCree))
Next noDonneeCree
Else
'S'il y a une seule colonne, la donnée à rechercher correspond à la donnée de celle-ci.
dataToRecherche = Trim(parametre(indiceParametre))
End If
For noDonneeRecherche = .Range(parametre(indiceParametre + 1) & "65536").End(xlUp).Row To ligneDepart Step -1
dataCree = ""
If nbDonneeRecherche > 1 Then
For noDonneeCree = 0 To nbDonneeRecherche * 2 - 1 Step 2
dataCree = dataCree & _
Trim(.Range(parametre(indiceparmetre + 1 + _
noDonneeCree) & noDonneeRecherche))
Next noDonneeCree
Else
dataCree = dataCree & _
Trim(.Range(parametre(indiceParametre + 1) & _
noDonneeRecherche))
End If
If dataToRecherche = dataCree Then
rechercheLigne = noDonneeRecherche
Exit Function
End If
Next noDonneeRecherche
End If
rechercheLigne = 0
End With
End Function
Je sais que se n'est pas une partie de plaisir, mais je sens qu'on s'approche du but.
En bref, mes macros fonctionne à merveille, sauf qu'elle prenne énormément de temps. C'est pour cette raison que je voudrais limite les "For" puisqu'avec plus de 4000 lignes dans la feuille "Taux" et avec 41 lignes et 8 colonnes dans la zone "Zone", je vous assure que les "for" tournent longtemps.
Merci.
