XL 2019 Calcul automatisé pour additionner des cellules

noobexcel2007

XLDnaute Nouveau
Bonsoir,

Je souhaite additionner des cellules en grande quantité en fonction du nombre de colonnes et du nombre de cellules par colonne.
Par exemple , si j'ai 3 colonnes de 10 cellules, je souhaite additionner les 1000 (10*10*10) combinaisons possibles.
Est-ce possible ?
Puis-je donner un nom à chaque cellule (donc 30 noms) afin de repérer facilement mon résultat ?
Par exemple , si on numérote de 1 à 30 les cellules, une de mes combinaisons sera 1-11-21 avec la somme de ces cellules. Est-il possible d'avoir à la fois "1-11-21" visible et le résultat ?
Merci de votre aide
 
Solution
Bonsoir @noobexcel2007,

Voici la version qui accepte une plage quelconque:
  • cliquer sur le bouton Hop!
  • sélectionner la plage à traiter
Le code est dans module1. Il travaille sur la feuille courante.

On y trouve une constante nommée ColonneSortie qui est la colonne à partir de laquelle on affiche les résultats. C'est à vous de l'adapter.

Pour un résultat aboutissant à 1 048 576 lignes (le max possible), j'oscille entre 15 s et 16 s en temps d'exécution (plage en rose).

VB:
Option Explicit

Const ColonneSortie = "n"

Sub Test()
Dim i&, j&, n&, nInd&, k&, xrgX As Variant, X, som, Debut, wks As Worksheet

' Lecture de la plage des données
Set wks = ActiveSheet
On Error Resume Next
Set xrgX =...

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @noobexcel2007,

Voici la version qui accepte une plage quelconque:
  • cliquer sur le bouton Hop!
  • sélectionner la plage à traiter
Le code est dans module1. Il travaille sur la feuille courante.

On y trouve une constante nommée ColonneSortie qui est la colonne à partir de laquelle on affiche les résultats. C'est à vous de l'adapter.

Pour un résultat aboutissant à 1 048 576 lignes (le max possible), j'oscille entre 15 s et 16 s en temps d'exécution (plage en rose).

VB:
Option Explicit

Const ColonneSortie = "n"

Sub Test()
Dim i&, j&, n&, nInd&, k&, xrgX As Variant, X, som, Debut, wks As Worksheet

' Lecture de la plage des données
Set wks = ActiveSheet
On Error Resume Next
Set xrgX = Application.InputBox(prompt:="Sélectionner la plage des données, svp...", Type:=8)
If xrgX Is Nothing Then
   MsgBox "Erreur dans la saisie de la plage", vbInformation
   Exit Sub
End If
wks.Select
Debut = Timer
On Error GoTo 0
X = xrgX.Value    'tableau des valeurs à traiter

' On normalise X (ie on remonte les valeurs de chaque colonne
'     pour supprimer les valeurs 'vides'). Le tableau résultat est T
' Parallèlement, on construit les vecteurs contenant les futurs
'     indices des colonnes et le nombre de valeur de chaque colonne de T
ReDim T(1 To UBound(X), 1 To UBound(X, 2))   ' T sera X mais normalisé
ReDim ind(1 To UBound(X, 2))                 'vecteur des indices de colonnes
ReDim max(1 To UBound(X, 2))                 'vecteur des nombres de valeurs de chaque colonne
Dim maxligne#                                'nombre de lignes du résultat

maxligne = 1
For j = 1 To UBound(X, 2)
   n = 0
   For i = 1 To UBound(X)
      If X(i, j) <> "" Then n = n + 1: T(n, j) = X(i, j)
   Next i
   If n = 0 Then
      MsgBox "La colonne " & j & " de la plage est vide. Arrêt du traitement.", vbInformation: Exit Sub
   Else
      max(j) = n: ind(j) = 0     ' avec initialisation de Ind
      maxligne = maxligne * n    'calcul du nombre de ligne du résultat
   End If
Next j

If maxligne > Rows.Count Then
   ' le nombre de ligne du résultat est supérieur au nombre de ligne de la feuille
   MsgBox "Le nbre de résultat est trop grand. Echec.", vbCritical
   Exit Sub
End If

ReDim res(1 To 250000, 1 To UBound(T, 2) + 1)   ' Tableau des résultats
Dim nres&         ' curseur de ligne du tableau résultat
ReDim v(1 To UBound(T, 2))    ' vecteur 'générique' intermédiaire d'une ligne
                              ' v ne contient pas les valeurs de T
                              ' mais pour élément un entier de 1 au nombre max de valeur
                              ' de la colonne
Range(Cells(1, ColonneSortie), Cells(1, Columns.Count)).EntireColumn.Clear
Application.ScreenUpdating = False: DoEvents
nInd = 1    'on ommence par travailler la colonne 1 de la plage
   Do
      'incrémentation de l'indice de la colonne nInd
      ind(nInd) = ind(nInd) + 1
    
      If ind(nInd) > max(nInd) Then
         'si l'indice dépasse le nombre de valeurs de la colonne nInd
         'alors on repasse tous les indices des colonnes >= nInd à zéro
         For k = nInd To UBound(T, 2): ind(k) = 0: Next
         'et on repart traiter le colonne nInd-1
         nInd = nInd - 1
      Else
         'l'indice de la colonne nInd est dans la limite du nombre max de valeurs de la colonne nInd
         v(nInd) = ind(nInd)        'On stocke l'indice nInd dans le vecteur résultat de la ligne
                                    ' à la colonne nInd
         If nInd = UBound(T, 2) Then
            ' si on a traité la dernière colonne de la plage
            ' on va stocker le résultat de la ligne dans le tableau résultat res()
            nres = nres + 1: som = 0   'incrémentation de la ligne et RAZ de la somme de la ligne
            ' on va stocker les valeurs dans la ligne nres du tableau res()
            ' l'instruction suivante ne sert que pour avoir un résultat générique.
            ' activer l'instruction suivante si c'est ce que vous désirez
            ' For k = 1 To UBound(v): res(nres, k) = v(k): Next: res(nres, UBound(res, 2)) = ""   'générique
            ' l'instruction suivante ne sert que pour avoir un résultat avec les valeurs de T
            ' la désactiver si vous désirez un résultat générique (indépendant des valeurs sources)
            For k = 1 To UBound(v): res(nres, k) = T(v(k), k): som = som + T(v(k), k): Next
            res(nres, UBound(res, 2)) = som     'stockage de la somme de la ligne
            If nres = UBound(res) Then
               'si on a complété la dernière ligne de res(), alors on l'affiche sur la feuille
               k = Cells(Rows.Count, ColonneSortie).End(xlUp).Row
               If k > 1 Then k = k + 1
               Cells(k, ColonneSortie).Resize(nres, UBound(res, 2)) = res
               nres = 0    'raz de l'index de ligne de l'écriture dans res()
            End If
         Else
            ' on n'a pas encore atteint la dernière colonne de la ligne
            ' on incrémente nInd pour traiter la colonne suivante
            nInd = nInd + 1
         End If
      End If
      ' condition de sortie de la boucle
      If nInd = 0 Then Exit Do
   Loop
   ' on teste si on a écrit des lignes dans res() depuis la dernière fois,
   ' si oui, on l'affiche sur la feuille
   If nres > 0 Then
      k = Cells(Rows.Count, ColonneSortie).End(xlUp).Row
      If k > 1 Then k = k + 1
      Cells(k, ColonneSortie).Resize(nres, UBound(res, 2)) = res
   End If

   ' Quelques mises en forme
   Cells(1, ColonneSortie).Offset(, UBound(T, 2)).Resize(maxligne).Font.Color = RGB(0, 0, 255)
   Cells(1, ColonneSortie).Resize(maxligne, UBound(res, 2)).NumberFormat = "0.00"
   MsgBox Format(maxligne, "#,##0\ Lignes pour une durée de ") & Format(Timer - Debut, "0.0\ sec."), vbInformation
End Sub
 

Pièces jointes

  • noobexcel2007 - somme- ver1.xlsm
    28.5 KB · Affichages: 13
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG