vba - MS Excel 进行子表/智能分组

Question

我在 MS Excel (2016) 中有 2 个数据表，需要将 2 个表中的数据合而为一进行分析。这是我需要的示意性问题:

() - Sheet1 - 主要

---------------------------
| id | product | manuf | q | 
---------------------------
| 001| prt_1   | man_1 |150|
---------------------------
| 002| prt_2   | man_2 |800|

()-sheet2-子主

--------------------
|id | date | prices|
--------------------
|001|17.01 | 120   |
--------------------
|001|16.02 | 99    |
--------------------
|002|17.03 | 110   |
--------------------
|002|15.02 | 10    |

() - 我想要做的就是像这样将它们分组

---------------------------
| id | product | manuf | q |
---------------------------
- | 001| prt_1   | man_1 |150|
  ----------------------------
   |001|17.01 | 120   |
   --------------------
   |001|16.02 | 99    |

---------------------------
+ | 002| prt_2   | man_2 |800|

换句话说，它类似于 MS Access SubDataSheet，我知道如何在 Acces 中执行此操作，但需要在 Excel 中执行。我尝试了数据透视表和电源枢轴，但仍然没有成功。

第二个变体是相同的任务，但源数据的版本不同。所有数据不再是两张纸，而是行数增加了一倍和三倍。不知道哪种变体更适合进行所需的分组。

--------------------------------------------
| id | product | manuf | q |  date | prices|  
--------------------------------------------
|001 | prt_1   | man_1 |150| 17.01 | 120   |
--------------------------------------------
|001 | prt_1   | man_1 |150| 16.02 | 99    |

是否有一些 VBA 代码可以执行此操作？需要帮助和建议。

Answer 1

类似这样的事情

Public Sub Program()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    i = 2
    j = 2
    k = 2

    Do While Worksheets("Sheet1").Cells(i, "A").Value <> ""
        'data from sheet1
        Worksheets("Result").Cells(k, "A").Value = Worksheets("Sheet1").Cells(i, "A").Value
        Worksheets("Result").Cells(k, "B").Value = Worksheets("Sheet1").Cells(i, "B").Value
        Worksheets("Result").Cells(k, "C").Value = Worksheets("Sheet1").Cells(i, "C").Value
        Worksheets("Result").Cells(k, "D").Value = Worksheets("Sheet1").Cells(i, "D").Value

        k = k + 1

        Do While Worksheets("Sheet1").Cells(i, "A").Value = Worksheets("Sheet2").Cells(j, "A").Value
            'data from sheet1
            Worksheets("Result").Cells(k, "A").Value = Worksheets("Sheet2").Cells(j, "A").Value
            Worksheets("Result").Cells(k, "B").Value = Worksheets("Sheet2").Cells(j, "B").Value
            Worksheets("Result").Cells(k, "C").Value = Worksheets("Sheet2").Cells(j, "C").Value
            Worksheets("Result").Cells(k, "D").Value = Worksheets("Sheet2").Cells(j, "D").Value

            k = k + 1
            j = j + 1
        Loop

        k = k + 1
        i = i + 1
    Loop
End Sub