vba - 根据字符串内容对组下的每个字符串进行分类(1 次)？ (Excel)

Question

复杂的问题……让我先解释一下，也许有更好的解决方案，而不是使用迭代计算:

(Link to Workbook)

Image showing example (to show what I'm working with)

问题:

拥有 4,000 多个字符串，并希望将它们分类为预先确定的组(基于字符串的内容)。

每个字符串只能分配给一个组。 (即“55 加仑桶水龙头”将列在“水龙头”列下，因为它包含“水龙头”一词。)

一旦分类到一个组中，该字符串将不会被分类到任何其他组下。 (即，“55 加仑桶形水龙头”一旦被归类为“水龙头”，就不会被归类为“桶”)。

只要对每个字符串进行分类，每个字符串都属于哪个组并不重要。

注: (我几乎找到了使用迭代计算的解决方案，但它并不完全有效)。

解决方案:

我解决问题的方法是:

使用以下公式计算字符串(A 列)在工作表中重复的次数:

 Formula: =COUNTIF($E$2:$IA$10000,A3)

这个公式在 C 列中。

创建了一个公式，该公式将根据字符串是否包含组词(即“水龙头”、“啤酒”、“加仑”、“厨房”等)对组下的字符串进行分类......并且之前没有使用过(即 C 列，其中包含上述公式)。

  Formula: =IF(C3<1,IF(IFERROR(SEARCH("faucet",A3),0)>0,A3,""),"")

为 C 列中的所有 4,000 个字符串以及每个单独的“组”列向下拖动公式。

这种方法的问题在于它会进行迭代计算，这将是:

将字符串归为组(但不会将重复次数字段从 0 增加到 1)...

或者

将“Times Dup'd”字段从 0 增加到 1，但会使字符串不会被归类在“组”列下。

关于如何解决迭代计算问题的任何建议？
(我知道它一直在来回计算，因为它是依赖的，所以必须解决 1 个“正确”的解决方案......我想知道是否有任何方法可以创建某种“ block ”，所以它只能计算一个方法...)

任何帮助将不胜感激!

Answer 1

通过您的数据运行此过程。它在一对变体数组中执行所有处理。

Sub byGroup()
    Dim g As Long, s As Long, aSTRs As Variant, aGRPs As Variant

    appTGGL bTGGL:=False

    With Worksheets("Sheet1")
        aSTRs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2
        With .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp).Offset(0, Application.Match("zzz", .Rows(1)) - 1))
            .Resize(.Rows.Count, .Columns.Count).Offset(1, 0).ClearContents
            aGRPs = .Cells.Value2
        End With

        For s = LBound(aSTRs, 1) To UBound(aSTRs, 1)
            For g = LBound(aGRPs, 2) To UBound(aGRPs, 2)
                If CBool(InStr(1, aSTRs(s, 1), aGRPs(1, g), vbTextCompare)) Then
                    aGRPs(s + 1, g) = aSTRs(s, 1)
                    Exit For
                End If
            Next g
        Next s

        .Cells(1, 5).Resize(UBound(aGRPs, 1), UBound(aGRPs, 2)) = aGRPs

    End With

    appTGGL
End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Debug.Print Timer
    Application.ScreenUpdating = bTGGL
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
End Sub

耗时(不包括您的工作表公式重新计算应在 1-2 秒范围内。

匹配组的优先级从左到右。如果您认为“55 加仑桶”应归为 鼓 而不是 加仑 然后确保鼓在第 1 行中位于加仑之前。

将启用宏的新工作簿另存为 Excel 二进制工作簿 (.XLSB) 可将工作簿文件大小减少大约一半。