结合行和工作表中的求和值

时间:2015-04-01 06:51:20

标签: excel vba merge pivot combinations

我有一张excel表,下面是(管道“|”分隔列)数据。

A|B|C|X|50|60
D|E|F|X|40|30
A|B|C|X|10|20
A|B|C|Y|20|20
A|B|C|X|20|70
D|E|F|X|10|50
A|B|C|Y|10|10

我想要的结果是:

A|B|C|X|80|150
A|B|C|Y|30|30
D|E|F|X|50|80

值A,B,C和D,E,F类似于唯一标识符。实际上只考虑A或D.值X和Y类似于“类型”,整数是要求的值。此示例已经过简化,有数千个唯一标识符,十几种类型和几十个要求的值。行未排序,类型可以位于更高或更低的行中。我试图避免使用数据透视表。

Dim LastRow As Integer
Dim LastCol As Integer
Dim i As Integer

LastCol = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To LastRow
????
Next i

上面的代码到了遍历行的地步但我不知道在那之后会发生什么。

1 个答案:

答案 0 :(得分:1)

  1. 在您认为重要的所有字母列上对它们进行排序。
  2. 在右侧未使用的列中,使用第二行中的公式,

    = IF($ A2& $ B2& $ C2& $ D2 = $ A3& $ B3& $ C3& $ D3,“”,SUMIFS(E:E,$ A:$ A,$ A2,$ B :$ B,$ B2,$ C:$ C,$ C2,$ D:$ D,$ D2))

  3. 将该公式复制到一列,然后将数据向下填充两列

  4. 过滤两列,删除空白。

    radiations measurements from a PRM-9000

  5. 可选择将数据复制到新的报告工作表中,并删除E& E列。 F。

  6. <强>附录:

    使用某种形式的数组和一些简单的数学运算可以实现更自动化的方法。我选择了一个字典对象,以便利用其索引的 Key 来识别前四个字母标识符中的模式。

    要使用脚本字典,您需要进入VBE的工具►参考并添加Microsoft Scripting Runtime。如果没有它,以下代码将无法编译。

    以下针对键和整数的动态列进行了调整。

    Sub rad_collection()
        Dim rw As Long, nc As Long, sTMP As String, v As Long, vTMP As Variant
        Dim i As Long, iNumKeys As Long, iNumInts As Long
        Dim dRADs As New Scripting.Dictionary
    
        dRADs.CompareMode = vbTextCompare
        iNumKeys = 5    'possibly calculated by num text (see below)
        iNumInts = 2    'possibly calculated by num ints (see below)
    
        With ThisWorkbook.Sheets("Sheet4").Cells(1, 1).CurrentRegion
            'iNumKeys = Application.CountA(.Rows(2)) - Application.Count(.Rows(2))  'alternate count of txts
            'iNumInts = Application.Count(.Rows(2))    'alternate count of ints
            For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).row
                    vTMP = .Cells(rw, 1).Resize(1, iNumKeys).Value2
                    sTMP = Join(Application.Index(vTMP, 1, 0), Chr(183))
                    If Not dRADs.Exists(sTMP) Then
                        dRADs.Add Key:=sTMP, Item:=Join(Application.Index(.Cells(rw, iNumKeys + 1).Resize(1, iNumInts).Value2, 1, 0), Chr(183))
                    Else
                        vTMP = Split(dRADs.Item(sTMP), Chr(183))
                        For v = LBound(vTMP) To UBound(vTMP)
                            vTMP(v) = vTMP(v) + .Cells(rw, iNumKeys + 1 + v).Value2
                        Next v
                        dRADs.Item(sTMP) = Join(vTMP, Chr(183))
                    End If
    
            Next rw
    
            rw = 1
            nc = iNumKeys + iNumInts + 1
            .Cells(rw, nc + 1).CurrentRegion.ClearContents  'clear previous
            .Cells(rw, nc + 1).Resize(1, nc - 1) = .Cells(rw, 1).Resize(1, nc - 1).Value2
            For Each vTMP In dRADs.Keys
                'Debug.Print vTMP & "|" & dRADs.Item(vTMP)
                rw = rw + 1
                .Cells(rw, nc + 1).Resize(1, iNumKeys) = Split(vTMP, Chr(183))
                .Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts) = Split(dRADs.Item(vTMP), Chr(183))
                .Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts) = _
                  .Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts).Value2
            Next vTMP
        End With
    
        dRADs.RemoveAll: Set dRADs = Nothing
    
    End Sub
    

    只需针对您提供的数字作为示例运行宏。我假设第一行中有某种形式的列标题标签。填充字典对象,并且组合标识符中的重复项将其数字相加。剩下的就是将它们拆分并将它们返回到未使用区域的工作表中。

    Rad measurement collection

    Microsoft Scripting Runtime的位置 - 在Visual Basic编辑器(又名VBE)中,选择工具►参考( Alt + T R )然后向下滚动一半以上才能找到它。

    Microsoft Scripting Runtime