2016-09-02 2 views
-5

Я делаю некоторый анализ, и мне нужна гистограмма, но данные мне нужно работать на суммируется, пример таблицы ниже:Разбивка сумм на частоты (для гистограммы)

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/macro для его выполнения?

+0

Если вы вставили копию элементов '1' и' 2' под существующими буквами '1' и' 2', вы можете просто скопировать элемент 3 вверх. – pnuts

+1

@pnuts Вы правы ... Я пропустил вопрос -.- –

+0

Привет @pnuts проблема (и я забыл упомянуть), что в таблице есть тысячи строк – adsa

ответ

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 
+0

Спасибо, сэр, это было именно то, что я искал !! – adsa

Смежные вопросы