bonjour a tous
on n'est dans un contexte de saisie d'aliments, composant fiche technique de recette de cuisine.
vaut mieux, un petit schémas, qu'un long discours.
comme vous pouvez le voir, sur ma capture d'écran ci-dessous

Nom : demoRechercheAliments080818.png
Affichages : 2079
Taille : 90,0 Ko


je peine, a centraliser, toutes mes recherches d'aliments qui compose ma recette; de la feuille "base" à ma feuille "FTRV1" ( fiche technique recette version1)
soit le scénario suivant recherché:

1) je saisie tous les aliments, composant ma recette , les unes à la suite des autres

2) je la recherche dans la feuille "base", je la trouve, et je fais correspondre leurs valeurs nutritionnelles à ma feuille "FTRV1" a des plages ranges bien précis

3) systématiquement, les valeurs s'additionneront à chaque aliments trouvés de ma feuille "base", composant ma recette, vers ma feuille "FTRV1" ( fiche technique recette version1)

pour info : ma feuille "base" de recherche est: BaseRange="B2:B5521" contenant 5521 lignes .
celle-ci est alimenté, avec de nouveaux aliments, et leurs valeurs énergétiques.
ci-joint le code de ma fonction recherche de base ci-dessous

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
 
Function FindAll(ByVal sDenree As String, ByRef baseFeuil As Worksheet, ByRef BaseRange As String, ByRef resCalorie() _
  As String) As Boolean
    On Error GoTo Err_Trap
        Dim rFnd As Range ' Range Object
            Dim iCalor As Integer ' Compteur pour tableau
                Dim rFirstAddress ' Addresse de la premiere recherche
                    Erase resCalorie ' efface le tableau
                       Set rFnd = baseFeuil.Range(BaseRange).Find(what:=sDenree, LookIn:=xlValues, lookAt:=xlPart) ' alloue toi, a la recherche
        If Not rFnd Is Nothing Then
            rFirstAddress = rFnd.Address
             Do Until rFnd Is Nothing
                iCalor = iCalor + 1
                    ReDim Preserve resCalorie(iCalor)
 
                         resCalorie(iCalor) = rFnd.Row  'c'est a ce niveau que je bloque, je souhaiterai formaté cette ligne, en fonction des valeurs que je veux restituer 
                                                                      ' comme le montre l'arrière plan de ma capture de mon écran
                                         --->suite  de mon code
 
                              Set rFnd = baseFeuil.Range(BaseRange).FindNext(rFnd) ' passe à la recherche suivante
                                If rFnd.Address = rFirstAddress Then Exit Do ' sort de la boucle Do
                                Loop
                                FindAll = True
                                Else
                                Err_Trap:  'La gestion des erreurs
                                If Err <> 0 Then
                            MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
                        Err.Clear
                    FindAll = False
                Exit Function
            End If
End Function


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
 
Function RedimArray(Table)
        RedimArray = Application.WorksheetFunction.Transpose(Table)
End Function
code ci-dessous à la mise en œuvre de ma fonction recherche des aliments qui compose ma recette saisie
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
 
 
Sub CalorieCal()
Dim PlagNature As Range: Set PlagNature = Range("G21:H61")
Dim strTabCalo() As Variant
Dim istrCal As Long
Dim caloTemp() As String 'variable tableau pour la fonction Findall
Dim Feuil_base As String
Dim iCal As Integer
Feuil_base = "base"
strTabCalo = RedimArray(PlagNature)  'dimenssionnement des aliments saisies, a passer en arguments à la fonction recherche
    For istrCal = 1 To UBound(strTabCalo)
        Debug.Print strTabCalo(istrCal)
 '---------------------------------------------------------------
            bFound = FindAll(strTabCalo(istrCal), Sheets(Feuil_base), BaseRange, caloTemp()) 'mise en oeuvre de ma fonction recherche des aliments
                If bFound = True Then
                    Debug.Print "Nb occurences : " & UBound(caloTemp)
                        For iCal = 1 To UBound(caloTemp)
 
            Debug.Print caloTemp(iCal) ' ici blocage a se niveau afin d'une restitution sur ma feuille maitre feuille "FTRV1", dans les plages bien précis, comme le montre ma    
                                                    ' capture d'écran  en avant plan
                                                      '----> ce qui a ci-dessous
                                                       'set resKcal=Range("H16:H17")
                                                       'set resProt=Range("K16:K17")
                                                       'set resGluc=Range("N16:N17")
                                                       'set resLipi=Range("P16:P17")
                                                        'se sont les plages, de ma feuille maitre "FTRV1" pour les résultats centralisés
 
        Next
      Next
    End If
End Sub
vraiment merci, a toutes aides de votre part; je suis coincé.
en espérant avoir donné le maximum d'éléments pour se scénario recherché
je suis un débutant en VBa, je me tarde de finir se petit projet, pour la saisie de recette de cuisine.

cordialement