将总和分解为频率(直方图)

时间:2016-09-02 22:24:57

标签: excel excel-vba vba

我正在进行一些分析,我需要一个直方图,但我需要处理的数据是相加的,如下表所示:

Item  Quantity  Cost
1         2       15
2         2       20
3         1       21

但是为了做直方图,我需要频率,所以表格应该如下:

Item  Quantity  Cost
1         1       15
1         1       15
2         1       20
2         1       20
3         1       21

有关如何做的任何想法?我需要一个vba /宏来完成它吗?

1 个答案:

答案 0 :(得分:0)

这应该可以解决问题。如果没有,它至少会让你开始。

 Sub Expand_Occurance()
    Dim ItemCounter As Long, shBottom As Long, NewItemRow As Long, OccuranceCounter As Long
    Dim sh As Worksheet
    Set sh = ActiveSheet
    shBottom = sh.Cells(Rows.Count, 1).End(xlUp).Row 'get the bottom row of column 1
    NewItemRow = shBottom + 1 'and the first new row to write to

    For ItemCounter = 2 To shBottom
        If sh.Cells(ItemCounter, 2) > 1 Then 'there's more than one occurance
            'this could probably be more elegant, but it works
            Do While sh.Cells(ItemCounter, 2) > 1
                sh.Range(sh.Cells(ItemCounter, 1), sh.Cells(ItemCounter, 3)).Copy destination:=sh.Cells(NewItemRow, 1)
                sh.Cells(NewItemRow, 2) = 1
                NewItemRow = NewItemRow + 1
            sh.Cells(ItemCounter, 2) = sh.Cells(ItemCounter, 2) - 1
            Loop
        End If
    Next ItemCounter

'then sort the results
    shBottom = sh.Cells(Rows.Count, 1).End(xlUp).Row 'get the new bottom row
    sh.Sort.SortFields.Clear
    sh.Sort.SortFields.Add Key:=Range("A2:A" & shBottom), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With sh.Sort
        .SetRange sh.Range("A1:C" & shBottom)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End Sub