从逻辑上parsing一个string在Excel中修剪附近的重复
假设string：
item1, item1N, item1Z, item1fhg, item1_any_letters, item2, item3, item3N, item3H 我的目标输出很简单
item1, item2, item3
这是目前大约10万行Excel文件，但可以暂时迁移到另一个程序等。
基本上我需要确定重复项（以数字结尾的任何初始短语），而不考虑数字后面的字母。 一些短语可能有例如“品牌item2，品牌item34”，唯一的决定因素是一个副本是任何和所有的术语后数字。
任何想法从哪里开始呢？ 每个string通常有2到500个值，用逗号和空格隔开。 最终价值之后没有逗号。
Sub Tester() Dim re As Object, match As Object Dim dict As Object Dim arr, arrItems, x As Long, y As Long Dim val, matches, valMatch Set dict = CreateObject("scripting.dictionary") Set re = CreateObject("VBScript.RegExp") re.Pattern = "([\w ]+\d+)" re.ignorecase = True re.Global = True arr = ActiveSheet.Range("A1:A100").Value For x = LBound(arr, 1) To UBound(arr, 1) arrItems = Split(arr(x, 1), ",") dict.RemoveAll For y = LBound(arrItems) To UBound(arrItems) val = Trim(arrItems(y)) If re.Test(val) Then Set matches = re.Execute(val) valMatch = matches(0).Value If Not dict.exists(valMatch) Then dict.Add valMatch, 1 End If Next y Debug.Print arr(x, 1) Debug.Print Join(dict.keys, ",") 'where do you want this? Next x End Sub
VBA方法与Tim的第一个途径类似
- 使用
RegExp删除无效的charcaters（数字之后的字符和逗号之前的字符） -
用消除重复
a）使用Dictionary
b）Excel的内置删除重复function（写入表单）Const strDelim = ", " Sub TestMe() Dim strTest As String Dim x strTest = "item1, item1N, item1Z, item1fhg, item1_any_letters, item2, item3, item3N, item3H" x = Split(DeDupe(strTest), strDelim) 'fix last element x(UBound(x)) = Left$(x(UBound(x)), Len(x(UBound(x))) - 1) Call Method2(x) End Sub Sub Method2(ByVal x) Dim objDic As Object Dim y As Variant Set objDic = CreateObject("Scripting.Dictionary") Dim lngRow As Long For lngRow = LBound(x) To UBound(x) objDic(x(lngRow)) = 1 Next lngRow MsgBox Join(objDic.keys, strDelim) End Sub Function DeDupe(strIn As String) As String Dim objRegex As Object Set objRegex = CreateObject("vbscript.regexp") With objRegex .Global = True .Pattern = "(.+?\d+)[^\d]+(,|$)" DeDupe = .Replace(strIn, "$1,") End With End Function
Option B
'another potential option. Not applied in this code Sub Method1(ByVal x) Dim y As Variant Dim rng1 As Range With ActiveSheet .[a1].Resize(UBound(x) + 1, 1) = Application.Transpose(x) .Columns("A").RemoveDuplicates Columns:=1, Header:=xlNo y = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp))) End With MsgBox Join(y, strDelim) End Sub
这可能是不完美的，因为这是一个快速的黑客，只删除最右边的非数字string。 您将需要一些正则expression式知识来调整它以满足您的需求。
无论如何，按照这里给出的“安装”步骤，保存模块，您将能够在您的工作表中写入一个公式，如
=S(A1;"[^0-9]*$";"")
比方说B1单元。 如果A1单元格包含“Item 1234 blah blah”，则B1现在将包含“Item 1234”。 将公式拖到B列的所有单元格中，然后将值保存到另一个Excel文件中进行sorting（或者，您可以尝试sorting和在位子计数）。
不幸的是，我不认为在10万个以上的电池中这样做是实际的（我甚至build议不要在现场进行小计处理）。
通过为Windows安装textools（sed，grep，uniq …），并通过filter来运行你的文件，你会好得多。 假设每一行代表上面的一个项目，一个filter如
sed -e 's/^\([^0-9][^0-9]*[0-9][0-9]*\).*/\1/g' | sort | uniq -c | sort -rn
会得到你的100,000行文件，并返回类似的东西
79283 Item 1 1234 Item 2 993 Item 3 ..........
（在某些平台上，你可以写（\ D + \ d +）而不是（[^ 0-9] …，但我不确定Windows的行为）。
更好的select工具是（草莓）Perl，也有CSV支持，或Python语言。