与查找

Question

我有一张代码表，它从一列获取一些值并进行小计。这个单元格不一样，所以我已经使用了.Find来定位它们。一旦它们被选中，目标就是将它们相加并将结果放在其他单元格列中，指定用于这些小计。我已经使用累加器制作了我的宏，问题是我找不到避免这些小计的总和的方法。愿有人帮忙吗？ 为了解释，我已经包含了这张照片。红色箭头是我想避免的积累。 谢谢大家！

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栏中的数字，这将在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