根据数量进行双重排序并添加重复项

Question

我有一份物品清单，包括每件物品的数量和类型。我想先按类型排序，然后按字母顺序排序，同时根据数量复制物品名称。

因此像这样的范围：

|  Item  |Quantity|  Type   |
|--------|--------|---------|
|Onion   |      1 |Vegetable|
|Lettuce |      5 |Vegetable|
|Tomato  |      1 |Vegetable|
|Cherry  |      3 |Fruit    |
|Apple   |      1 |Fruit    |
|Broccoli|      1 |Vegetable|

变成这样（在不同位置不影响原始范围）：

|--------|--------|---------|
|Apple   |      1 |Fruit    |
|Cherry  |      1 |Fruit    |
|Cherry  |      2 |Fruit    |
|Cherry  |      3 |Fruit    |
|Broccoli|      1 |Vegetable|
|Lettuce |      1 |Vegetable|
|Lettuce |      2 |Vegetable|
|Lettuce |      3 |Vegetable|
|Lettuce |      4 |Vegetable|
|Lettuce |      5 |Vegetable|
|Onion   |      1 |Vegetable|
|Tomato  |      1 |Vegetable|

原始范围最多可以有 50 行，最多可以有 20 种不同类型。数量不会超过 50，但 90% 的情况下只有 1 个。

我不知道该如何实现这一点。我以前使用过 Index/Match 和 Offset，但这超出了我的能力范围。

我正在使用 Office 365（版本 2208），看看是否有区别。

Answer 1

假设数据按照您的示例位于 A:C 列中，请使用以下宏：

Sub MacroVBA()
Dim workingSheet As Worksheet
Dim newSheet As Worksheet
Dim originalRange As Range
Dim newRange As Range
Dim item As Range
Dim quantity As Integer
Dim i As Integer

Set workingSheet = ActiveSheet
Set newSheet = ThisWorkbook.Worksheets.Add

Set originalRange = workingSheet.Range("A1:C" & workingSheet.Cells(Rows.Count, "A").End(xlUp).Row)

originalRange.Sort key1:=originalRange.Columns(3), order1:=xlAscending, _
                    key2:=originalRange.Columns(1), order2:=xlAscending, _
                    Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
                    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

originalRange.Rows(1).Copy newSheet.Range("A1")

Set newRange = newSheet.Range("A2")

For Each item In originalRange.Rows
    On Error Resume Next
    quantity = CInt(item.Cells(1, 2).Value)
    On Error GoTo 0
    
    For i = 1 To quantity
        newRange.Value = item.Cells(1, 1).Value
        newRange.Offset(0, 1).Value = i
        newRange.Offset(0, 2).Value = item.Cells(1, 3).Value
        Set newRange = newRange.Offset(1, 0)
    Next i
Next item

End Sub

转到包含您数据的工作表，然后执行宏。然后，根据您的要求排序的数据将粘贴到新工作表中。检查一下，如果您想编辑某些内容，请告诉我。

Answer 2

这也可以通过 Power Query 来实现，可在 Windows Excel 2010+ 和 Excel 365（Windows 或 Mac）中使用

使用 Power Query

• 在数据表中选择一些单元格
• Data => Get&Transform => from Table/Range
• 当 PQ 编辑器打开时：Home => Advanced Editor
• 记下表格姓名在第 2 行
• 将下面的 M 代码粘贴到您所看到的位置
• 将第 2 行的表名改回最初生成的表名。
• 阅读评论并探索Applied Steps以了解算法

let

//change next line to reflect data source
    Source = Excel.CurrentWorkbook(){[Name="Produce"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Item", type text}, {"Quantity", Int64.Type}, {"Type", type text}}),

//Duplicate the rows according to Quantity
    #"Duplicate Rows" = List.Accumulate({0..Table.RowCount(#"Changed Type")-1},{},(state, current)=> 
        state & List.Repeat({#"Changed Type"{current}}, #"Changed Type"{current}[Quantity])),

//Convert list of records to table and expand.
    #"Converted to Table" = Table.FromList(#"Duplicate Rows", Splitter.SplitByNothing(), null, null, ExtraValues.Error),
    #"Expanded Column" = Table.ExpandRecordColumn(#"Converted to Table", "Column1", {"Item", "Quantity", "Type"}),

//Remove the Quantity Column
    #"Removed Columns" = Table.RemoveColumns(#"Expanded Column",{"Quantity"}),

//Group by Item and add Index column to each sub group
    #"Grouped Rows" = Table.Group(#"Removed Columns", {"Item"}, {
        {"Add Index", each Table.AddIndexColumn(_,"Index",1), type table [Item=text, Type=text, Index=Int64.Type]}
        }),

//Remove the Item column and expand the grouped tables
    #"Removed Columns1" = Table.RemoveColumns(#"Grouped Rows",{"Item"}),
    #"Expanded Add Index" = Table.ExpandTableColumn(#"Removed Columns1", "Add Index", {"Item", "Type", "Index"}),

//Set the Column Order
    #"Reorder Columns" = Table.ReorderColumns(#"Expanded Add Index",{
        "Item","Index","Type"}),

//Set the sorted order
    #"Sorted Rows" = Table.Sort(#"Reorder Columns",{{"Type", Order.Ascending}, {"Item", Order.Ascending}, {"Index", Order.Ascending}})
in
    #"Sorted Rows"