Boucle de fusion de cases, dimensions inégales

Bonsoir à tous

Je suis loin du domaine informatique et j'essaie de faire des efforts à résoudre un problème que j'ai rencontré, et je sollicite votre aide.

Je suis sur excel 2013 FR, et j'essaie d'écrire un code qui fait un calcul de mécanique des sols (géotechnique). Je vous présente mon problème:

J'ai plusieurs types de sol sur plusieurs couches (de C19 à C61), chaque couche est subdivisée en des profondeurs élémentaires (de D 19 à D61) . Voici un exemple:

C | D

------------------

19 Argile | 1

20 Argile | 0,4

21 Argile | 2,5

22 Argile | 0,1

23 sable | 1

24 sable | 0.5

25 sable | 6.1

26 silte | 2

27 silte | 4,1

Je veux avoir la profondeur totale de chaque couche sur des cellules fusionnées; par exemple la couche argile aura une profondeur de 4m sur les cellules fusionnées de E19 à E22 et la couche sable aura 7.6m sur les cellules fusionnées de E23 à E25.

Le type du sol peut changer, donc les profondeurs aussi et parsuite le nombre de cases à fusionner.

Ci-joint un exemple explicatif, la colonne rouge est le résultat souhaité.

Merci infiniment

Bonsoir,

Joins-nous un fichier Excel avec les données d'exemple et explique ce que tu attends comme résultat. Par exemple d'après ce que tu as mis je trouve plutôt 4 comme profondeur en argile et non pas 3,1

je m'excuse pour la faute.

ci-joint un exemple, la colonne en rouge c'est le résultat souhaité

Bonsoir,

Je ne pense pas que ce soit une bonne idée de fusionner des cellules, surtout que les fusions sont de dimensions inégales et peuvent au surplus varier ! C'est vouloir créer un casse-tête de toute pièce.

Une simple formule que j'ai mis en F pour que tu puisses comparer ; tu la tapes en ligne 19 et tu la tires jusqu'à la ligne 61 :

=SI($C19=$C18;SOMME(F18;$D19);$D19)

Elle va faire la totalisation par couches. Mais tu mets la police à blanc. Et en MFC, tu choisis un format police gras et couleur auto, et bordure inférieure. Avec la formule conditionnelle suivante :

=$C19<>$C20 qui s'applique de F19 à F61 (la colonne importe peu mais il faut taper la formule après avoir la plage de la première ligne où elle s'applique à la dernière).

Le résultat pour chaque couche apparaîtra sur la dernière ligne de chacune, au-dessus d'un trait séparant chaque couche.

Tu peux peaufiner la mise en forme par centrale et couleur de fond qui fera disparaître les séparations de cellules...

Lors d'évolutions, si tu procèdes par glissements (sans insertion de ligne) tout s'adaptera. Il n'y aura sans doute qu'à allonger la plage d'application de la MFC.

Par contre, si insertion de ligne, il faudra retirer la formule de la ligne précédant l'insertion jusqu'à la fin. Et vérifier la MFC qui devrait s'adapter mais risque de se fractionner.

Cordialement

Merci pour votre réponse.

En effet je veux vraiment un code VBA, parceque ceci est une partie d'un long code.

Merci pour votre aide

Bonsoir à tous,

Vois ceci :

Option Explicit

Sub test()
Dim i As Long, j As Long, k As Long, derlig As Long
Dim txtH As String, txtB As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheets(1)
        k = 1
        derlig = .Cells(Rows.Count, "B").End(xlUp).Row
        For i = 19 To derlig
            txtH = Join(Array(.Cells(i, 2), .Cells(i, 3)), Chr(2))
            txtB = Join(Array(.Cells(i + 1, 2), .Cells(i + 1, 3)), Chr(2))
            If txtH = txtB Then
                k = k + 1
            Else
                If k > 1 Then
                    j = i - k + 1
                    .Cells(j, 5).Value = Application.Sum(.Range(.Cells(j, 4), .Cells(i, 4)))
                    .Range(.Cells(j, 5), .Cells(i, 5)).Merge
                    k = 1
                Else
                    .Cells(i, 5).Value = .Cells(i, 4).Value
                End If
            End If
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

klin89

merciiiiiiiiiiiiiiiiiii Klin89, c'est Nikel!