Excel 按其他标准合并后按标准求和VBA

Excel 按其他标准合并后按标准求和VBA,excel,vba,Excel,Vba,我正在做一个项目,根据不同的标准集合合并和求和单元格。原始数据包含类别A、B和C;其中每个都包含从a到j的子类别(动态)。不必在一个类别下显示所有子类别 我需要通过以下命令进行合并和计算: 在较大类别A、B和C下,合并第4列“聚合”中每个类别的单元格(成功) 求和d、e和h的和,如果它们出现在每个类别下,则返回结果。例如,如果在A下,d和e表示为4和5,则与A对应的大合并单元格应显示4+5=9;如果在B、h、d、e下表示为8,9,10,则相应的合并单元格应为8+9+10=27。效果如图所示

我正在做一个项目,根据不同的标准集合合并和求和单元格。原始数据包含类别A、B和C;其中每个都包含从a到j的子类别(动态)。不必在一个类别下显示所有子类别

我需要通过以下命令进行合并和计算:

  • 在较大类别A、B和C下,合并第4列“聚合”中每个类别的单元格(成功)

  • 求和d、e和h的和,如果它们出现在每个类别下,则返回结果。例如,如果在A下,d和e表示为4和5,则与A对应的大合并单元格应显示4+5=9;如果在B、h、d、e下表示为8,9,10,则相应的合并单元格应为8+9+10=27。效果如图所示
  • 我已经编写了代码,但是在进行计算时返回不匹配。详情如下:

    Sub shishi()
    
    Application.DisplayAlerts = False
    
    Dim row As Long
    Dim lr As Long
    Dim rng As Range
    Dim rng2 As Range
    
    lr = Sheets(1).Cells(Rows.Count, 1).End(xlUp).row
    
    MergeCells:
    
        For Each rng In Range(Cells(2, 4), Cells(lr, 4))
        
            If rng.Offset(0, -3).Value = _
            rng.Offset(1, -3).Value And _
            rng.Offset(0, -3).Value <> "" Then
            Range(rng, rng.Offset(1, 0)).Merge
                    
            GoTo MergeCells
            End If
            
        Next
        
        For Each rng2 In Range(Cells(2, 2), Cells(lr, 2))
        
            If rng2.Value = "d" Or "e" _
                Or "h" And _
                rng2.Offset(0, -1).Value = _
                rng2.Offset(1, -1).Value Then
                
                Sum = Sum + rng2.Offset(0, 1).Value
                rng2.Value = Sum
                Else
                Sum = 0
            End If
        Next
    
    Application.DisplayAlerts = True
    
    End Sub
    
    Sub石狮()
    Application.DisplayAlerts=False
    暗排一样长
    变暗lr为长
    变暗rng As范围
    变暗rng2 As范围
    lr=工作表(1).单元格(Rows.Count,1).结束(xlUp).行
    合并单元格:
    对于范围内的每个rng(单元格(2,4),单元格(lr,4))
    如果rng.偏移量(0,-3)。值=_
    rng.偏移量(1,-3).值和_
    rng偏移量(0,-3)。值“”然后
    范围(rng,rng.Offset(1,0)).Merge
    转到合并单元格
    如果结束
    下一个
    对于范围内的每个rng2(单元格(2,2),单元格(lr,2))
    如果rng2.Value=“d”或“e”_
    或“h”和_
    rng2.偏移量(0,-1)。值=_
    rng2。偏移量(1,-1)。然后是值
    总和=总和+rng2.偏移量(0,1).值
    rng2.值=总和
    其他的
    总和=0
    如果结束
    下一个
    Application.DisplayAlerts=True
    端接头
    
    任何想法或方向都将受到真诚的感谢!首先谢谢大家

    2020年10月9日下午15:50编辑: 在BigBen的提示下,代码几乎可以完美地工作,当我将其实现到原始大数据集时,出现了一个问题。合并的问题是只保留了左上角的数字-这正是我不想要的,因此我交换了计算/合并的顺序,并添加了一个函数,以便在后期合并阶段交换数字

    在修正了另一个关于当前行的类别是否为下一行的类别将跳过该行的逻辑之后,我让它检查上面的行以确定值是否相同

    我遇到了一个新问题,在B和C类别之间,子类别e是相同的,而我的逻辑应该是找出不等式并重置总和计数,但它没有…并将B的总和直接带入C的计算中

    以下是原始数据的当前设置和代码:

    我更新了一些值,以创建一个更直接的表示数字差异的案例(以及代码错误计算的更明显指示)

    Sub石狮()
    Application.DisplayAlerts=False
    暗排一样长
    变暗lr为长
    变暗rng As范围
    变暗rng2 As范围
    变暗温度,如长
    lr=工作表(1).单元格(Rows.Count,1).结束(xlUp).行
    对于范围内的每个rng2(单元格(2,2),单元格(lr,2))
    如果rng2.Value=“d”或_
    rng2.Value=“e”或_
    rng2.Value=“h”和_
    rng2.偏移量(0,-1)。值=_
    rng2。偏移量(-1,-1)。然后是值
    总和=总和+rng2.偏移量(0,1).值
    rng2.偏移量(0,2).值=和
    其他的
    总和=0
    如果结束
    下一个
    合并单元格:
    对于范围内的每个rng(单元格(2,4),单元格(lr,4))
    如果rng.偏移量(0,-3)。值=_
    rng.偏移量(1,-3).值和_
    rng偏移量(0,-3)。值“”然后
    如果rng.Offset(1,0).Value>rng.Value,则
    温度=转速偏移量(1,0)
    燃烧值=温度
    如果结束
    范围(rng,rng.Offset(1,0)).Merge
    转到合并单元格
    如果结束
    下一个
    Application.DisplayAlerts=True
    端接头
    
    这也是剩下的唯一问题——我的所有其他代码都完全按照预期运行。再次非常感谢

    编辑:2020年10月9日下午16:55


    事实上,代码比我想象的更为破烂……我想收集任何建议,使逻辑正确。请忽略我对代码的评论,因为它几乎可以工作了。谢谢…

    rng2.Value=“d”或“e”或“h”和
    不起作用。你必须重复比较的左边
    如果rng2.Value=“d”或rng2.Value=“e”或rng2.Value=“h”
    谢谢@BigBen!我已经接受了伟大的答案!不显示数据图像,显示(数据、预期结果、实际结果代码)Hi@ComputerVersteher我正在为格式化文本更正数字。非常感谢。
    Sub shishi()
    
    Application.DisplayAlerts = False
    
    Dim row As Long
    Dim lr As Long
    Dim rng As Range
    Dim rng2 As Range
    Dim temp As Long
    
    lr = Sheets(1).Cells(Rows.Count, 1).End(xlUp).row
        
        For Each rng2 In Range(Cells(2, 2), Cells(lr, 2))
        
            If rng2.Value = "d" Or _
                rng2.Value = "e" Or _
                rng2.Value = "h" And _
                rng2.Offset(0, -1).Value = _
                rng2.Offset(-1, -1).Value Then
                
                Sum = Sum + rng2.Offset(0, 1).Value
                rng2.Offset(0, 2).Value = Sum
                Else
                Sum = 0
            End If
        Next
        
    MergeCells:
    
        For Each rng In Range(Cells(2, 4), Cells(lr, 4))
        
            If rng.Offset(0, -3).Value = _
            rng.Offset(1, -3).Value And _
            rng.Offset(0, -3).Value <> "" Then
            
                If rng.Offset(1, 0).Value > rng.Value Then
                temp = rng.Offset(1, 0).Value
                rng.Value = temp
                End If
                
            Range(rng, rng.Offset(1, 0)).Merge
            
            GoTo MergeCells
            End If
            
        Next
    
    Application.DisplayAlerts = True
    
    End Sub