Findとの累積合計

Question

私は、ある列からいくつかの値を取り、小計を作成するコードを持つシートを持っています。この細胞は今までと同じではないので、私は使用されています。一度それらが選択されると、目的はそれらを合計し、これらの小計を有するために指定された他のセル列に結果を置きます。私はアキュムレータを使用してマクロを作っていますが、問題は私もこれらの小計の合計を避ける方法を見つけることができません。誰か助けてもらえますか？ 私はこの写真を説明しました。赤い矢印は、私が避けたいと思っている蓄積です。 ありがとうございます！

Codification & accumulates

コードを使用：

Sub Mod9x() 
    Dim cell As Range 
    Dim arr As Variant, arrElem1 As Variant, arrElem2 As Variant, arrElem3 As Variant 
    Dim sumtotal As Variant 
    Dim sh1 As Worksheet 
    Subtotal = 0 
    subs = 0 
    Set sh1 = Sheets("Valeurs") 
    lr = sh1.Range("E" & Rows.Count).End(xlUp).row 

     With Worksheets("Valeurs") 
     For i = 15 To lr 
      For Each cell In sh1.Cells(i, 5) 

      arr = Split(Replace(cell.Value, " ", " "), " ") 
        For Each arrElem1 In arr 
         If Len(arrElem1) = 22 Then 
         lResult1 = Left(arrElem1, Len(arrElem1) - 8) 
          Set findv1 = Range("E15:E3000").Cells.Find(What:=lResult1, LookAt:=xlWhole, _ 
          after:=Range("E15"), SearchDirection:=xlPrevious) 
          findv1.Offset(, 16).Select 

             With Selection.Interior 
             .Pattern = xlSolid 
             .PatternColorIndex = xlAutomatic 
             .ThemeColor = xlThemeColorAccent4 
             .TintAndShade = 0.399975585192419 
             .PatternTintAndShade = 0 
             End With 

          lResult2 = arrElem1 

          Set findv2 = Range("E15:E3000").Cells.Find(What:=lResult2, LookAt:=xlWhole, _ 
          after:=Range("E15"), SearchDirection:=xlPrevious) 

          If findv2.Offset(, 1) <> "" And findv2.Offset(, 2) <> "" And findv2.Offset(, 10) <> "" Then 

           findv2.Offset(, 15).Select 
           Subtotal = Subtotal + findv2.Offset(, 15) 
           findv1.Offset(, 16) = Subtotal 

           Set findco = Range("E15:E3000").Cells.Find(What:=findv1, LookAt:=xlWhole, _ 
           after:=findv1, SearchDirection:=xlNext) 

             With Selection.Interior 
             .Pattern = xlSolid 
             .PatternColorIndex = xlAutomatic 
             .ThemeColor = xlThemeColorAccent3 
             .TintAndShade = 0.399975585192419 
             .PatternTintAndShade = 0 
             End With 

          End If 
         End If 
       Next arrElem1 
      Next cell 
      Next i 
     End With 

End Sub 

Answer 1

を列A、列B内の番号にテキストと簡単なシナリオ、コメントに続き、これは4アンダースコアとAの値を見つけるだろうし、 C列に累積的に結果を追加してください。

Sub x() 

Dim r As Range, d As Double 

For Each r In Columns(1).SpecialCells(xlCellTypeConstants) 
    If UBound(Split(r, "_")) = 5 Then 
     d = d + r.Offset(, 1).Value 
     r.Offset(, 2).Value = d 
    End If 
Next r 

End Sub