[已解决]模糊去重，数据提取。请大神帮忙，不胜感激！！

别离殇情 · 发表于 2022-2-26 18:56

本帖最后由别离殇情于 2022-2-26 18:59 编辑

样本数据.rar (431 KB, 下载次数: 5)

limonet · 发表于 2022-2-26 18:56

这个最佳答案由 limonet 给出，感谢 limonet 的回答。

单击隐藏图章

本帖最后由 limonet 于 2022-2-26 22:09 编辑

要求都满足
Sub test()
On Error Resume Next
Dim i%, Match, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
      Dic(Left(Cells(i, 1), 55)) = ""
Next i
Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).ClearContents
[A2].Resize(UBound(Dic.keys) + 1, 1) = Application.Transpose(Dic.keys)
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
      With CreateObject("vbscript.regexp")
         .Global = True
         .MultiLine = True
         .Pattern = "[0-9]{8,11}"
         Cells(i, 1) = .Replace(Cells(i, 1), "12345678900")
         .Pattern = "(?=售)?[0-9]{2,}\.?[0-9]{0,2}?万"
         Set Match = .Execute(Cells(i, 1))
         Cells(i, 2) = Match(0)
         .Pattern = "[0-9]{2,}\.?[0-9]{0,2}?平?[平方]"
         Set Match = .Execute(Cells(i, 1))
         Cells(i, 3) = Match(0)
      End With
Next i
End Sub

别离殇情 · 发表于 2022-2-26 22:05

limonet 发表于 2022-2-26 21:52
要求都满足
Sub test()
On Error Resume Next

感谢大神帮忙，数据提取做的非常准确
还有一个问题，他这个模糊去重问题能不能解决
附件中已标出需要去重的例子

样本数据2.rar (378.89 KB, 下载次数: 3)

		自动登录	找回密码
密码			注册

[已解决]模糊去重，数据提取。请大神帮忙，不胜感激！！

最佳答案