Trouver Le max avec critaire

Bonjour

je souhaite trouver le max avec critaire d'une plage et deplacer ou copier la ligne de ce max vers une autre feuil

je vous explique

j'ai une plage dynamique A3:K"Dernierligne"

la colonne Critaire Z c'est la colonne K sans doublons

je cherche le max de la colonne G3:G"DernierLigne" avec le critaire de chaque element de la colonne Z

apres je copier la ligne de ce max et la copier vers une autre feuil

next critaire de la colonne Z

et voila un exemple pour ma question

Sub Macro1()
Dim VM As Currency
Dim i As Long
Dim Trouve As Range
On Error GoTo fin
For i = 3 To 107
    VM = Application.WorksheetFunction.MaxIfs(Range("G3:G1631"), Range("K3:K1631"), Range("Z" & i))
    Set Trouve = Range("G3:G1631").Find(What:=VM, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    Trouve.Rows.Copy
    Sheets("Resultat souhaiter").Range("A3").Paste 'et apres A4 et apres A5 .........

Next i

fin:

End Sub

Bonjour,

Si j'ai bien compris, il s'agit de récupérer la ligne correspondante au débit max de chaque jour ?
A mon avis, ce serait plus rapide (et simple) avec un tableau croisé dynamique.

bonjour

merci mr pour votre réponse et oui TDC est rapide et je sais cette méthode mais je ne peux pas utilisé TDA car mon code après va contient des conditions pour exécuté si et sinon

iliess a écrit :

bonjour

merci mr pour votre réponse et oui TDC est rapide et je sais cette méthode mais je ne peux pas utilisé TDA car mon code après va contient des conditions pour exécuté si et sinon

Désolé mais là c'est carrément incompréhensible !

J'ai repris un peu votre code initial, mais je pense que la boucle de 3 à 103 n'est pas adaptée, car elle balaye des dates en doublons et en omet certaines. N'étant pas certain du besoin exact, je tâtonne un peu...

Sub Macro2()

Dim VM As Double, Lig As Long, DerLig As Long, Trouve As Range, NbRes As Integer
On Error GoTo fin
With Sheets("GrandLivre")
    DerLig = .Range("G" & Rows.Count).End(xlUp).Row
    For Lig = 3 To 107
        VM = Application.MaxIfs(.Range("G3:G" & DerLig), .Range("K3:K" & DerLig), .Range("Z" & Lig))
        Set Trouve = .Range("G3:G" & DerLig).Find(What:=VM, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Trouve Is Nothing Then
            NbRes = NbRes + 1
            Trouve.EntireRow.Copy Sheets("Resultat souhaiter").Range("A" & NbRes + 2)
        End If
    Next Lig
End With
fin:
End Sub

Autre essai avec boucle sur les dates modifiées

Sub Macro2()

Dim VM As Double, Dte As Long, DerLig As Long, Trouve As Range, NbRes As Integer
On Error GoTo fin
With Sheets("GrandLivre")
    DerLig = .Range("G" & Rows.Count).End(xlUp).Row
    For Dte = Application.Min(.Range("K3:K" & DerLig)) To Application.Max(.Range("K3:K" & DerLig))
        VM = Application.MaxIfs(.Range("G3:G" & DerLig), .Range("K3:K" & DerLig), Dte)
        Set Trouve = .Range("G3:G" & DerLig).Find(What:=VM, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Trouve Is Nothing Then
            NbRes = NbRes + 1
            Trouve.EntireRow.Copy Sheets("Resultat souhaiter").Range("A" & NbRes + 2)
        End If
    Next Dte
End With
fin:
End Sub

Bonjour

Bonjour à tous

Un essai à teste, à tout hasard...

Option Explicit

Dim tablo, tabloR(), fGL As Worksheet, dico As Object
Dim i&, j&, k&

Sub Résultat()

    Set fGL = Sheets("GrandLivre")
    tablo = fGL.Range("A3:K" & fGL.Range("A" & Rows.Count).End(xlUp).Row)
    ReDim tabloR(1 To UBound(tablo, 1), 1 To UBound(tablo, 2))
    Set dico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tablo, 1)
        If Not dico.exists(tablo(i, 1)) Then
            dico(tablo(i, 1)) = tablo(i, 7)
        Else
            dico(tablo(i, 1)) = Application.Max(dico(tablo(i, 1)), tablo(i, 7))
        End If
    Next i

    k = 0
    For i = 1 To UBound(tablo, 1)
        If dico(tablo(i, 1)) = tablo(i, 7) Then
            For j = 1 To 11
                If j = 7 Then
                    tabloR(k + 1, j) = dico(tablo(i, 1))
                Else
                    tabloR(k + 1, j) = tablo(i, j)
                End If
            Next j
            k = k + 1
        End If
    Next i

    Range("A2").CurrentRegion.Offset(1, 0).ClearContents
    Range("A3").Resize(UBound(tabloR, 1), 11) = tabloR
    Range("A3").Resize(UBound(tabloR, 1), 11).Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlNo
End Sub

Bye

bonjour Mr Pedro22 merci pour votre code mais ça marche pas

iliess a écrit :

bonjour Mr Pedro22 merci pour votre code mais ça marche pas

Me voilà bien avancé pour vous aider... On ne sait jamais, apporter des précisions pourrait peut être, je dis bien peut-être, vous donner une chance d'avoir une aide plus pertinente ! Quid de la proposition de gmb (salut au passage )?

Bonjour Mr gmb Votre code et pratique, ideé de stocké le max dans un tableau est parfaite mais il manque qu'elle que chose dans le code car le max ne fonctione pas et dans feuil resultat manque plusieur date

je vais excuter votre code etape par etape et je vous rendre compte de tous les detail

merci

bonjour

Mr gmb

la premeire chose constaté que la liste critaire pour la fonction Max est la colonne Z non pas la colonne A

la premeire chose constaté que la liste critaire pour la fonction Max est la colonne Z non pas la colonne A

En fait, il y a dans la colonne Z la suite continue des dates depuis la date la plus ancienne de la colonne A jusqu’à la date la date la plus récente de cette même colonne A.

Sachant cela, la macro reconstitue la liste des dates (sans doublon) de la colonne A et les mets dans un dictionnaire. Elle ne se sert donc pas de la liste des dates de la colonne Z.

Elle retient alors, pour chaque date de la colonne A la valeur maximale de la colonne G (DEBIT) ainsi que les autres valeurs de la ligne où se trouve ce maximum.

C’est ce que j’ai voulu faire. Mais si ce n’est pas ce qu’il fallait faire, désolé c’est que je n’ai rien compris

Maintenant, s’il y a une erreur dans le résultat attendu, il me faudrait un exemple pour que je trouve d’où cela vient.

Bye !

Bonjour

C'est la colonne K "date synthèse" qui est le critère de la fonction max.si

la colonne A c'est des date de système elle n'est pas importante

le soir je vous donne tous les étapes avec un exemple

merci

C'est la colonne K "date synthèse" qui est le critère de la fonction max.si

Qu'à cela ne tienne :

Option Explicit

Dim tablo, tabloR(), fGL As Worksheet, dico As Object
Dim i&, j&, k&

Sub Résultat()

    Set fGL = Sheets("GrandLivre")
    tablo = fGL.Range("A3:K" & fGL.Range("A" & Rows.Count).End(xlUp).Row)
    ReDim tabloR(1 To UBound(tablo, 1), 1 To UBound(tablo, 2))
    Set dico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tablo, 1)
        If Not dico.exists(tablo(i, 11)) Then
            dico(tablo(i, 11)) = tablo(i, 7)
        Else
            dico(tablo(i, 11)) = Application.Max(dico(tablo(i, 11)), tablo(i, 7))
        End If
    Next i

    k = 0
    For i = 1 To UBound(tablo, 1)
        If dico(tablo(i, 11)) = tablo(i, 7) Then
            For j = 1 To 11
                If j = 7 Then
                    tabloR(k + 1, j) = dico(tablo(i, 11))
                Else
                    tabloR(k + 1, j) = tablo(i, j)
                End If
            Next j
            k = k + 1
        End If
    Next i

    Range("A2").CurrentRegion.Offset(1, 0).ClearContents
    Range("A3").Resize(k, 11) = tabloR
    Range("A3").Resize(k, 11).Sort key1:=Range("K3"), order1:=xlAscending, Header:=xlNo
End Sub

Bye !

Un très joli travail c’est exactement ce que je souhaite faire

Merci pour votre temps et pour vos informations et votre soutient

Mille merci Mr

Bonjour Mr gmb

J'ai édité un nouveau code avec une idée différente que la tienne

J’ai utilisé le filtre avance ça marche très bien mais ton code reste rapide que le mieux

Sub Test_V1()
Dim ShGrLvr As Worksheet, ShResul As Worksheet
Dim RgData As Range, RgCriter As Range, RgExe As Range
Dim i As Long, j As Long, DerK As Long, DerQ As Long
Dim SomSiG As Currency, SomSiH As Currency, Diff As Currency
Set ShGrLvr = ThisWorkbook.Worksheets("GrandLivre")
Set ShResul = ThisWorkbook.Worksheets("Resultat")
Set RgCriter = ShGrLvr.Range("A1:K2")
DerK = ShGrLvr.Cells(ShGrLvr.Rows.Count, 1).End(xlUp).Row
Set RgData = ShGrLvr.Range("A5:K" & DerK)
Set RgExe = ShGrLvr.Range("A6:K" & DerK)
DerQ = ShGrLvr.Cells(ShGrLvr.Rows.Count, 17).End(xlUp).Row
With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
End With
ShResul.Range("A3:K1000").ClearContents
For i = 6 To DerQ
    Range("K2").Value = Range("Q" & i).Value
    Range("G2").Value = Application.WorksheetFunction.MaxIfs(Range("G6:G" & DerK), Range("K6:K" & DerK), Range("K2"))
    RgData.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=RgCriter, Unique:=False
    DerA = ShResul.Cells(ShResul.Rows.Count, 1).End(xlUp).Row + 1
    RgExe.SpecialCells(xlCellTypeVisible).Range(Cells(1, 1), Cells(1, 11)).Cut ShResul.Range("A" & DerA & ":K" & DerA)
    SomSiG = Application.WorksheetFunction.SumIf(Range("K6:K" & DerK), Range("K2"), Range("G6:G" & DerK))
    SomSiH = Application.WorksheetFunction.SumIf(Range("K6:K" & DerK), Range("K2"), Range("H6:H" & DerK))
    Diff = SomSiG - SomSiH
        If Diff <> 0 Then
            DerA = ShResul.Cells(ShResul.Rows.Count, 1).End(xlUp).Row + 1
            Range("G2").Value = Application.WorksheetFunction.MaxIfs(Range("G6:G" & DerK), Range("K6:K" & DerK), Range("K2"))
            RgData.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=RgCriter, Unique:=False
            RgExe.SpecialCells(xlCellTypeVisible).Range(Cells(1, 1), Cells(1, 11)).Cut ShResul.Range("A" & DerA & ":K" & DerA)
        End If
Next i
With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
End With
ActiveSheet.ShowAllData
End Sub