MACRO VBA complexe - Organiser groupes selon variables

Le 16/09/2023 à 15:36

Bonjour,

J'ai un tableau Excel et je travaille avec ChatGPT pour optimiser les macros que je lui apporte.

Il y a une macro qui me donne du fil à retordre et qui concerne la création de groupes en fonction de différentes conditions.

Dans le fichier joint, il y a la feuille RESA. C'est la seule qui nous intéresse

ici.

Dans la plage A5:N5 sont notés le nombres de groupes nécessaires. Valeur absolue ni plus ni moins.
Dans la plage A6:N6 sont notés le nombres de personnes MAXIMUM dans ce groupe. Cette valeur est absolue est ne peut pas être dépassée bien qu'elle puisse être moindre.

Dans chaque colonne entre A8:N158 et jusque que N8:158 correspond donc une excursion/visite à faire.

On voit aussi qu'en T jusque AG il y a les mêmes excursions listés et que dans ces colonnes entre la ligne 8 et 158 on retrouves des quantités de 0 à 1.

On voit aussi que dans la colonne P on liste des Tables à coté des numéros de chambres.

Ce sont là les informations importantes pour cette macro.

J'aimerais que cette macro crée les groupes en mettant les gens ensemble par table pour qu'ils puissent faire les visites ensemble.
J'aimerais aussi que la valeur présente en ligne 5 et 6 soient respectées comme précisé ci-dessus.

Enfin, j'aimerais que selon les nationalités présentes en colonne R, les gens soient dans le même groupe et qu'on ne mélange pas des gens parlant des langues différentes. Exemple du document, pas de DE ( Germanophone ) avec des FR (Francophone) par exemple.

A chaque execution de la macro elle doit pouvoir m'organiser des groupes de tailles similaires quand c'est possible et non pas des groupes de 4 personnes et un autre de 23...
Si c'est 17, 24; 20 c'est bon, mais pas de grosse différence de plus de 10 personnes par exemple.

La partie des langues est la partie dont j'ai le plus de mal à mettre en place.

Sauriez-vous m'aider à finaliser la macro svp ? Elle s'appelle "ORGANISER_GROUPES_EXCU_AUTO"

Merci d'avance.

Sub ORGANISER_GROUPES_EXCU_AUTO()
    Dim col As Integer
    For col = 1 To 14
        AssignGroupsForExcursion col
    Next col
End Sub

Sub AssignGroupsForExcursion(col As Integer)
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long, TotalGroups As Integer, MaxGroupSize As Integer
    Dim CurrentGroup As Integer, CurrentGroupSize As Integer, TotalCabins As Integer
    Dim CabinList() As Variant, CabinIndex As Integer
    Dim TableList As Object, CurrentTable As Variant
    Dim Nationality As String

    Set ws = ThisWorkbook.Sheets("Resa")
    LastRow = 158
    TotalGroups = ws.Cells(5, col).Value
    MaxGroupSize = ws.Cells(6, col).Value
    Dim CorrespondingCol As Integer
    CorrespondingCol = col + 19

    If IsEmpty(TotalGroups) Or TotalGroups = 0 Then Exit Sub

    ReDim CabinList(1 To LastRow - 7)
    Set TableList = CreateObject("Scripting.Dictionary")
    TotalCabins = 0

    Dim GroupSizes() As Integer
    ReDim GroupSizes(1 To TotalGroups)
    For i = 1 To TotalGroups
        GroupSizes(i) = 0
    Next i

    For i = 8 To LastRow
        Nationality = ws.Cells(i, 18).Value  ' Column R
        If ws.Cells(i, CorrespondingCol).Value = 1 And Not IsEmpty(ws.Cells(i, 16).Value) And _
           Not (Nationality = "ES" Or Nationality = "MX" Or Nationality = "AR" Or Nationality = "CL" Or Nationality = "IT" Or Nationality = "PT") Then
            TotalCabins = TotalCabins + 1
            CabinList(TotalCabins) = i
            If Not TableList.Exists(ws.Cells(i, 16).Value) Then
                TableList.Add ws.Cells(i, 16).Value, ws.Cells(i, 16).Value
            End If
        End If
    Next i

    Dim SortedTables() As Variant
    SortedTables = SortTablesByCount(TableList, ws)

    For Each CurrentTable In SortedTables
        Dim TableSize As Integer
        TableSize = CountTableMembers(ws, CurrentTable)
        CurrentGroup = FindSmallestGroup(GroupSizes)
        GroupSizes(CurrentGroup) = GroupSizes(CurrentGroup) + TableSize

        For i = 1 To TotalCabins
            CabinIndex = CabinList(i)
            If ws.Cells(CabinIndex, 16).Value = CurrentTable Then
                ws.Cells(CabinIndex, col).Value = CurrentGroup
            End If
        Next i
    Next CurrentTable

    Set ws = Nothing
    Set TableList = Nothing
End Sub

Function CountTableMembers(ByRef ws As Worksheet, ByVal tableNum As Variant) As Integer
    Dim i As Long, count As Integer
    count = 0
    For i = 8 To 158
        If ws.Cells(i, 16).Value = tableNum Then
            count = count + 1
        End If
    Next i
    CountTableMembers = count
End Function

Function SortTablesByCount(TableList As Object, ByRef ws As Worksheet) As Variant
    Dim i As Long, j As Long, Tables() As Variant, Temp As Variant
    Tables = TableList.Keys
    For i = LBound(Tables) To UBound(Tables) - 1
        For j = i + 1 To UBound(Tables)
            If CountTableMembers(ws, Tables(i)) < CountTableMembers(ws, Tables(j)) Then
                Temp = Tables(i)
                Tables(i) = Tables(j)
                Tables(j) = Temp
            End If
        Next j
    Next i
    SortTablesByCount = Tables
End Function

Function FindSmallestGroup(GroupSizes() As Integer) As Integer
    Dim i As Integer, minSize As Integer, minIndex As Integer
    minSize = GroupSizes(1)
    minIndex = 1
    For i = 2 To UBound(GroupSizes)
        If GroupSizes(i) < minSize Then
            minSize = GroupSizes(i)
            minIndex = i
        End If
    Next i
    FindSmallestGroup = minIndex
End Function
Le 16/09/2023 à 19:29

Bonjour,

pour faire avancer le schmilblick car je n'aurai pas trop le temps...
Déjà il faut se poser la question de la faisabilité. Ca devrait faire l'objet d'une 1ère passe.
Comment fais-tu pour mettre 91 personnes dans 3 groupes de 25 sans même parler des contraintes supplémentaires ?
Et si ça rentre que fais-tu si le nombre de groupes est insuffisant en raison des contraintes ? Tirage au sort des éliminés ?

Le 16/09/2023 à 19:32

Bonsoir et merci de ta réponse;

La valeur 3 était mis au hasard alors que j'avais moins de personnes inscrites, pour 91 personnes j'aurais effectivement au moins 4 ou 5 groupes.

Le 16/09/2023 à 19:54

Bonjour Pharaon88 ou devrais-je dire Kévin

Je viens de supprimer votre fichier qui contient des données personnelles

Je ne suis pas certains que les clients qui emprunteront le bateau soient heureux de voir leur nom et numéro de réservation affichés sur un forum.

Je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER] et notamment

  • Dans tous les cas, ne postez JAMAIS de fichiers avec des informations personnelles ou confidentielles (cet utilitaire peut vous aider à les retirer).

Merci d'y faire attention SVP

Bonne soirée

Le 16/09/2023 à 20:12

Hello,

Voici le fichier anonymisé :)

29tableau-excu-2023-vierge-ven.xlsm (238.54 Ko)
Le 19/09/2023 à 07:59

Bonjour,

Ne faudrait-il pas commencer par faire un tri en fonction de tous ces critères(Table, Chambre, Langue parlée, Nationalité, Choix des excursions)?

Ça peut vous faciliter la tâche pour vos répartitions.

Dans le fichier joint, j'ai libérer les colonnes AL et AN pour y loger des formules, en AL, une formule pour concaténer les 1 et le 0 des excursions (il faut qu'il y ait impérativement 0 dans les zones oranges) et dans la colonne AN, un regroupement par "Langue parlée".

Ensuite en appliquant un tri sur ces critères, on obtient une réorganisation du tableau qui se rapproche de ce que vous demandez, il ne vous reste plus qu'à faire la répartition par nombre dans chaque groupe car ça, au vu de certaines contraintes, je pense, ne peut se faire que manuellement.

Si ça peut vous aider pour la suite!

le fichier réorganisé:

13pharaon88-macro-vba-complexe-organiser-groupes-selon-variables.xlsm (256.43 Ko)

la macro des répartitions:

Sub Repartition()
    Application.ScreenUpdating = False
    Range("AL7").Value = "concaténation des excursions"
    Range("AN7").Value = "langue parlée"
    Range("AL8:AL158").FormulaR1C1 = "=RC[-18]&RC[-17]&RC[-16]&RC[-15]&RC[-14]&RC[-13]&RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]"
    Range("AN8:AN158").FormulaR1C1 = "=IF(OR(R[10]C[431]={""BE"";""LU"";""CH"";""MC""}),""Francophone"",IF(OR(R[10]C[431]={""DE"";""DK"";""AT""}),""Germanophones"",""Anglophones""))"

    Range("A7:AN158").Select
    ActiveWorkbook.Worksheets("Resa").Sort.SortFields.Clear
    'tri par table
    ActiveWorkbook.Worksheets("Resa").Sort.SortFields.Add2 Key:=Range("P8:P158"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'tri par chambre
    ActiveWorkbook.Worksheets("Resa").Sort.SortFields.Add2 Key:=Range("O8:O158"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'tri par la langue parlée
    ActiveWorkbook.Worksheets("Resa").Sort.SortFields.Add2 Key:=Range("AN8:AN158"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'tri par nationalité
    ActiveWorkbook.Worksheets("Resa").Sort.SortFields.Add2 Key:=Range("R8:R158"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'tri par assemblage des excursions
    ActiveWorkbook.Worksheets("Resa").Sort.SortFields.Add2 Key:=Range("AL8:AL158"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Resa").Sort
        .SetRange Range("A7:AN158")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Cdlt

Le 19/09/2023 à 12:16

Hello et merci,

Je n'ai pas vraiment compris l'utilité de la concaténation ici ?
La formule en AN n'est pas juste puisqu'elle met tous le monde en anglophones. Je n'ai que des germanophones et francophones dans cette liste.

Vous ne pensez-pas qu'excel soit capable d'automatiser les groupes avec les critères demandés ?

Le 19/09/2023 à 12:41
Je n'ai pas vraiment compris l'utilité de la concaténation ici ?
Le but est de créer un texte en associant les n° affecter aux excusions, ainsi avec 1 seule cellule on connaît les excursions sélectionnées, exemples:
11100000000000 correspond aux excursions: "Basilique, Murano, Balade gourmande".
01010111000000 correspond aux excursions: "Murano, Padoue, Excu 6, Excu 7, Excu 8"
Cela permet d'obtenir un classement par groupe qui feront les mêmes excursions.

La formule en AN n'est pas juste puisqu'elle met tous le monde en anglophones. Je n'ai que des germanophones et francophones dans cette liste.
Petit incident de parcours, la formule corrigée:
=SI(OU($R8={"BE";"LU";"CH";"MC"});"Francophone";SI(OU($R8={"DE";"DK";"AT"});"Germanophones";"Anglophones"))
le fichier corrigé:
14pharaon88-macro-vba-complexe-organiser-groupes-selon-variables.xlsm (257.15 Ko)

Vous ne pensez-pas qu'excel soit capable d'automatiser les groupes avec les critères demandés ?
Ce n'est pas qu'excel ne soit pas capable, c'est plutôt, trouver un code qui le fasse, mais encore faut-il avoir bien compris le raisonnement à suivre.

Si c'est faisable manuellement, ça doit pouvoir se faire mais, il faudrait voir plusieurs exemples résolus manuellement pour en faire un diagramme et, à partir de là écrire le code et, vu le nombre de cas et de combinaisons possibles, c'est pas gagné.
Je pense qu'avec le tableau déjà trié , la répartition manuelle doit être plus facile à réaliser.

Cdlt
Le 19/09/2023 à 12:49

Hello,

Merci de ces corrections.

La répartition manuelle je sais la faire facilement par expérience dans mon métier, je sais qui va ou, c'est juste rebarbatif ;)

Le 19/09/2023 à 13:03

La répartition manuelle je sais la faire facilement par expérience dans mon métier, je sais qui va ou, c'est juste rebarbatif ;)

C'est pour ça qu'il faut trouver une logique des répartitions. Il vous faut noter les étapes sur la façon dont vous procédez pour arriver au résultat final en tenant compte des conditions(choix) qui se présentent (si c'est tel cas, je fais ceci, sinon je fais cela), c'est à partir de ce raisonnement que l'on peut construire un diagramme et enfin fournir le code équivalent.

Le 22/09/2023 à 12:48

Hello,

Desolé pour la réponse tardive.

Voici un exemple sur 2 excursions ou j'ai manuellement fais les groupes.
Voici ce à quoi ça devrait ressembler.
Les langues ont respectées? Aucun germanophones melangés au francophones et vice-versa.
Les tables sont respectées.

La logique devrait être :

Dans la plage A8:A158 : si les valeurs de la plage O8:O158 sont inscrits à l'excursion (Voir en colonne correspondante T en T8:T158)
ET SI en plage P8:P158 ils sont la sur la même table ( valeur identique A1 ou D3 ou B3, etc )
Et SI en plage R8:R158 ils sont dans la même catégorie de langue ( définie par la plage : P159:P199 et R159:R199).
Ex : SI FR alors catégorie 1, si DE alors catégorie 3, si US = catégorie 2, etc

ALORS SI LES CONDITIONS PRECEDENTES SONT REMPLIES, METTRE DANS LE MÊME GROUPE.
SI notamment les deux premières conditions ne sont pas remplies, ne pas mettre dans un groupe

Voilà la logique de base à appliquer, je ne sais pas si tu arrives à comprendre mes explications ;) ^^

17tableau-excu-2023-vierge-ven.xlsm (240.94 Ko)
Le 23/09/2023 à 09:59

Bonjour,

Ce n'est pas très clair, je suppose que les chiffres que vous mettez dans les colonnes A à N sont les n° de groupes, et que si pour les mêmes excursions, mêmes langues, mêmes tables vous mettez ces personnes dans un même groupe, comment expliquez-vous qu'il y ait 2 groupes différents pour les mêmes critères, exemple: lignes 58 à 61, même nationalité, mêmes excursions, tables différentes, bien que ce dernier critère ne semble pas pris en compte dans la répartition.

Et puis, de combien de personnes maximum sont admissibles dans un même groupe?

Vous avez commencé avec ChatGpt, il ne vous à pas fourni la bonne réponse, peut-être aussi parce que comme moi, il lui manque des éléments pour pouvoir répondre correctement.

Cdlt

Le 23/09/2023 à 17:18

Hello,

De A à N :
en ligne 5 sont le nb de groupes
En ligne 6 le nb de personnes par groupe pax.
Une fois ce quota dépassé, il faudrait passer à un second groupe.

Je l'avais très précisément expliqué à ChatGPT dans cet exemple.

J'ai corrigé les 3 oublis manuels que j'ai fais sur la BALADE GOURMANDE, j'avais oublié des gens.
Erreur humaine ici.

17tableau-excu-2023-vierge-ven.xlsm (239.35 Ko)
Le 24/09/2023 à 09:22

Bonjour,

Désolé j'abandonne, je ne comprends pas toute la logique de répartition des personnes ni la constitution des groupes, c'est trop confus pour moi. Il n'y a que vous qui connaissez le principe de réorganisation et c'est pour ça que vous pouvez le faire à la main.

Je vous souhaite de trouver quelqu'un qui comprendra mieux ou bien peut-être qu'en étant plus précis dans votre demande, ChatGPT pourra vous aider.

Mille excuses, j'ai bien essayé mais pour moi c'est trop flou.

Sincèrement désolé.

Cdlt

Le 24/09/2023 à 12:17

bonjour,

résumé, balade gourmant = 116 personnes qu'on doit divisé en 4 groupes de max 35 personnes en réspectant la même langue (plusieurs nationalité = colonne R) et leur groupe (colonne S) et une différence de max 10 personnes entre les groupes. C'est ça ?

La colonne V, c'est quoi ?

Le 24/09/2023 à 19:12

bonjour, une organisation des groupes avec la language et le numéro/nom du groupe = "Diviser". Le chiffre entre parenthèses est la language

19tableau-excu-2023-vierge-ven-2.xlsm (256.45 Ko)
Rechercher des sujets similaires à "macro vba complexe organiser groupes variables"