人工观察了一下,基本是以(空格-空格)为分隔点,前面是产品描述后面是包装描述
产品代码基本上会有以下情形,但不排除有特别情况不在正则表达式考虑之内,用人工进行判别
A.空格-空格后面是英文空格数字 [CYCLOMER ACA Z250 - CSP 16]
B.空格-空格后面是英文空格 [ALNOVOL PN 760/PAST - SPL ]
C.空格-空格后面是英文空格带() [CRYLCOAT 45064 - PLB 25 (PAL 750KG)]
> 方法1.去除相匹配字符
Option Explicit
'/将Sheet1中Material Description清理
'/去除包装描述
'/Rule:空格-空格后面移除
'正则表达式说明: |表示选择匹配;\s=空格;\w任意非特别字符
'\s-\s\w*\s\w* 空-空字空字
'\s-\s\w* 空-空字
'\s\(\w*\s\w*\) 空(字空字)
Sub Identify_SKU()
Dim arr, brr
Dim i%, j%
Dim sk$
arr = Sheet1.UsedRange '获取原始数据
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1) '定义输出数据+1列
'-------------------------------------------------------------------
brr(1, 1) = "Cleared"
For j = 1 To UBound(arr, 2) '循环原始数据首行
brr(1, j + 1) = arr(1, j) '数据复制
Next j
'-------------------------------------------------------------------
With CreateObject("vbscript.regexp") '创建正则对象
.Pattern = "\s-\s\w*\s\w*|\s-\s\w*|\s\(\w*\s\w*\)" '正则表达式:该表达式描绘了所要去除的字符或字符串特征
.Global = True '设置:要把所有的符合上句特征的字符或字符串都做处理.
For i = 2 To UBound(arr) '循环原始数据行
'If i = 230 Then Stop 'Debug
sk = arr(i, 4) '处理字段读入变量
sk = .Replace(sk, "") '移除正则匹配字段
' .Pattern = "\s\(\w*\s\w*\)"
' sk = .Replace(sk, "")
brr(i, 1) = UCase(sk) '将英文字母改为大写
For j = 1 To UBound(arr, 2) '循环原始数据列
brr(i, j + 1) = arr(i, j) '数据复制
Next j
Next i
End With
Sheet2.UsedRange.Clear '清除输出工作表
Sheet2.Cells(1, 1).Resize(UBound(brr), UBound(brr, 2)) = brr '数据输出
Erase arr
Erase brr
End Sub
> 方法2.获取最后一个匹配值前字符
Sub Remove_Range_Special()
Dim arr, brr
Dim i As Long, j As Long
Dim n As Long
Dim sk$
Dim Reg As Object
Dim Matches
Dim Match
Dim Position
Set Reg = CreateObject("vbscript.regexp") '创建正则对象
arr = Sheet1.UsedRange
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
'-------------------------------------------------------------------
brr(1, 1) = "Cleared"
n = 1
For j = 1 To UBound(arr, 2) 'Loop
brr(n, j + 1) = arr(1, j) '标题栏
Next j
'-------------------------------------------------------------------
Stop
With Reg
.Pattern = "\s-\s\w*\s\w*|\s-\s\w*|\s-\s\(\w*\s\w*\)" '正则表达式:该表达式描绘了所要去除的字符或字符串特征
.Global = True '设置:要把所有的符合上句特征的字符或字符串都做处理.
.IgnoreCase = True
End With
For i = 2 To UBound(arr)
If Not arr(i, 4) = "ZHIB" Then
n = n + 1
sk = arr(i, 3)
Set Matches = Reg.Execute(sk) '查找所有匹配值
For Each Match In Matches
Position = Match.FirstIndex '获取最后一个匹配值的位置
Next Match
'sk = Reg.Replace(sk, "")
sk = Mid(sk, 1, Position) '获取最后一个匹配值前面的字符
brr(n, 1) = UCase(sk) '将英文字母改为大写
For j = 1 To UBound(arr, 2)
brr(n, j + 1) = arr(i, j) '复制数据
Next j
End If
Next i
Sheet2.UsedRange.Clear
Sheet2.Cells(1, 1).Resize(UBound(brr), UBound(brr, 2)) = brr
Erase arr
Erase brr
End Sub