VBA-正则表达式实列

 

人工观察了一下,基本是以(空格-空格)为分隔点,前面是产品描述后面是包装描述

产品代码基本上会有以下情形,但不排除有特别情况不在正则表达式考虑之内,用人工进行判别

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

 

转载于:https://my.oschina.net/tedzheng/blog/667186

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值