VBA - 按A列中的数据分组时输出所有可能的数据集组合

Posted 2023-03-31

【中文标题】VBA - 按A列中的数据分组时输出所有可能的数据集组合

【英文标题】：VBA - Output all possible combinations of data sets when grouped by data in Column A

【发布时间】：2014-02-19 22:02:09

【问题描述】：

我决定从头开始这个问题，以澄清问题和目标。

关于我的数据的注意事项

我有一个包含笔记本电脑产品数据的电子表格 每个产品都有一个型号和一个 SKU 值 许多型号都有多个与之关联的 SKU 当一个模型中有多个 SKU 时，每个 SKU 都会有一个新行。在这种情况下，每一行在模型字段中都有相同的值 某些型号可能有 4 个电池和 1 个充电器，其他型号可能有 1 个电池和 2 个充电器，其他型号可能有 1 个电池和没有充电器，反之亦然...我想说的是没有固定规则或SKU 数量之间的关系 有两种产品，电池和充电器 所有电池产品的 SKU 都以“BAT”开头 所有充电器产品都有以“ACA”或“ACS”开头的 SKUS 我可以轻松拆分两种类型的数据来帮助实现目标 - SKU、型号和类别数据可以并排放置在列中，也可以针对每种类型的产品（电池或充电器）放在单独的工作表中

在同一工作表中并排格式化的示例数据：

单独工作表中的示例数据（sheet1 = 电池，sheet2 = 充电器）：

无论使用哪种方法，模型字段都可以位于 A 列中的任何位置 - 比较两组数据时，模型字段不会位于相邻单元格中（如图所示）

我正在努力实现的目标

对于每个型号，我需要有一行数据，其中包含一个电池 SKU 和一个充电器 SKU 在为该模型输出所有组合之前，应为同一模型创建一个新行 每行的输出中最多应有 2 个 SKU。这应始终包含 1 个电池和 1 个充电器

期望的输出

值得一提的是，这是我将使用的数据的一个非常小的样本，完整的数据集超过 60k 行并且还在不断增长，因此解决方案需要高效。

我正在使用 excel 2007。

我是 VBA 的菜鸟，我已经购买了一些插件来尝试实现我的目标，我花了 2 天时间研究并尝试了各种方法来做到这一点，但都无济于事。

我以为我已经接近 Santosh 的这个答案了：https://***.com/a/19780188/1018153 这是我上一个问题的基础，但是除了在模型之间产生重复和匹配数据之外，我实际上无法以完整的形式格式化我的数据，以便该脚本无论如何都适合我，所以我最初的问题是无关紧要的.

【问题讨论】：

你没有添加足够的细节。您正在使用的当前代码是什么，哪些代码不能按预期工作？如果你得到modelB ONE TWO 和modelB ONE THREE 会发生什么？如果你得到modelA ONE TWO 和modelA TWO TWO 会发生什么

我已经完全改写了这个问题，以（希望）让它更容易理解，而且它也对我有用，因为我忽略了一个关键问题！也许我链接到的另一个答案的作者也会遇到这个问题？ @桑托什

【参考方案1】：

下面的语句应该仍然有效，但我编写了代码来尝试解释它是如何工作的

Option Explicit 'This ensures typos in variable names are flagged

Sub MakeList()
Dim BatteryList As Range
Dim ChargerList As Range
Dim CurrentModel As String
Dim i As Long
Dim j As Long
Dim k As Long

Dim resultrange As String

'look at the lists - note I am not looking at the type - I'm going to assume
'that we can set the address correctly

'use End(xLdown) to find the last cell - that way we don't need to
'remember to change it when the number of items changes
Set BatteryList = Worksheets("Sheet1").Range("A2", Range("sheet1!B1").End(xlDown))
Set ChargerList = Worksheets("Sheet2").Range("A2", Range("Sheet2!B1").End(xlDown))
'note the use of the Sheet2! and sheet1! in the .End(xlDown) - this is required
'even though we have the Worksheets(" to set the range

i = 2 ' result row
For j = 1 To BatteryList.Rows.Count ' look at each battery row
    CurrentModel = BatteryList(j, 1)
    For k = 1 To ChargerList.Rows.Count 'then look at each charger row
        If ChargerList(k, 1) = CurrentModel Then
            'and only write a row if the battery and charger models match
            Worksheets("Sheet3").Cells(i, 1) = CurrentModel
            Worksheets("Sheet3").Cells(i, 2) = BatteryList(j, 2)
            Worksheets("Sheet3").Cells(i, 3) = ChargerList(k, 2)
            i = i + 1
        End If
    Next k
Next j

End Sub

---

上一个答案

---

查看您指出的问题中的代码，您需要存储当前模型，并且仅在模型匹配时添加可能性。当数据被写出时，这将导致大量 #N/A! ，但这应该是一个小问题。

在这一行：

 Do While j <= UBound(c1)

我会插入代码来保存当前模型

 Dim OnlyThisModel as string
 Do While j <= UBound(c1)
     OnlyThisModel=c1(j,1)

在这个领域

            Do While m <= UBound(c4)
                out(n, 1) = c1(j, 1)
                out(n, 2) = c2(k, 1)
                out(n, 3) = c3(l, 1)
                out(n, 4) = c4(m, 1)
                n = n + 1
                m = m + 1
            Loop

检查模型是否正确，不正确不要写：

            Do While m <= UBound(c4)
                if c1(j,1)=OnlyThisModel then
                    'Only write out data if model matches
                    out(n, 1) = c1(j, 1)
                    out(n, 2) = c2(k, 1)
                    out(n, 3) = c3(l, 1)
                    out(n, 4) = c4(m, 1)
                    n = n + 1
                end if
                'go to next record, regardless of if a combination was written
                m = m + 1
            Loop

【讨论】：

对不起，肖恩，原来的问题搞砸了，所以不得不完全编辑它。您的答案现在可能不适用

添加了说明和示例代码，使用分隔的表格作为示例。当我们在代码中设置范围时，数据在哪里并不重要，只是模型在第 1 列，电池/充电器信息在第 2 列。我还假设您在 sheet3 上设置了标题行把信息放在下面。

哇，肖恩，很好的答案。也感谢代码的详细解释！虽然它适用于较小的数据集，但当我在完整的数据集（60k 电池行和 38k 充电器行）上运行它时，我收到“运行时错误'6'：溢出”错误。点击调试按钮后，它会突出显示这一行：“For j = 1 To BatteryList.Rows.Count ' 查看每个电池行”。有没有办法让您出色的解决方案在处理大量数据时不会出错？

经过一番谷歌阅读后，我已将“整数”的 3 个实例更改为“长”。再次运行脚本并且没有错误，它现在已经运行了 20 分钟，并且我想在它完成处理之前，excel 已经停止运行了！完成后会更新

经过3个小时终于完成了处理。您是否有任何其他建议可以让您的代码快速且无错误地运行？