复杂的问题……让我先解释一下,也许有更好的解决方案,而不是使用迭代计算:
(Link to Workbook)
Image showing example (to show what I'm working with)
问题:
拥有 4,000 多个字符串,并希望将它们分类为预先确定的组(基于字符串的内容)。
注: (我几乎找到了使用迭代计算的解决方案,但它并不完全有效)。
解决方案:
我解决问题的方法是:
Formula: =COUNTIF($E$2:$IA$10000,A3)
Formula: =IF(C3<1,IF(IFERROR(SEARCH("faucet",A3),0)>0,A3,""),"")
这种方法的问题在于它会进行迭代计算,这将是:
或者
关于如何解决迭代计算问题的任何建议?
(我知道它一直在来回计算,因为它是依赖的,所以必须解决 1 个“正确”的解决方案......我想知道是否有任何方法可以创建某种“ block ”,所以它只能计算一个方法...)
任何帮助将不胜感激!
最佳答案
通过您的数据运行此过程。它在一对变体数组中执行所有处理。
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) 可将工作簿文件大小减少大约一半。
关于vba - 根据字符串内容对组下的每个字符串进行分类(1 次)? (Excel),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/34845719/