[求助]高难度！提取名称、型号、单位问题[已完成]

adaigua

运用了oobird版主的算法，感觉还不错，不过在大量运用的时候还是出错了，现上传附件如下：请问是什么原因呢？ 

a4I6mWAS.rar (9.17 KB, 下载次数: 1)

2007-8-29 17:01 上传

点击文件名下载附件
[求助]高难度！提取名称、型号、单位问题

jjw530

QUOTE:

以下是引用adaigua在2007-8-26 12:24:19的发言：

在实际应用中我发现对这一行进行操作时有误：

绝缘子P-15M只：变成了：绝缘子，这P-15，M只。

脑袋都大了，烦请在有时间的时候帮我解决一下为谢~

路过，插一句：型号的最后是数字，所以M也被做为单位。测试时没有发现“这”字符。

jjw530

初学者，请两位版主看看我理解的对不对：

1、taller版主严格按照楼主给定的规则判断逐字符判断确定最后一个汉字和最后一个数字出现的位子

2、oobird版主通过判断最后字符的ASC和UNICODE取得单位，因此碰到单字母单位时就会出错，比如米-"M”。这点上需要做出调整。

maillgh

真有高人

maillgh

!!!

adaigua

参考上述两位高手的现在给出完善答案：考虑单位有可能是汉字、字母（汉字为一位、字母可能有两位）；而名称与型号间可能有希腊字母的情况，按照字母与汉字、希腊字母的asc编码与ascw编码不一样的特点，现修改如下，运行良好~

Sub 提取名称型号单位()
    Dim a As String, i%, j%
    x = ActiveSheet.UsedRange.Rows.Count
        For j = 4 To x + 3
        a = Trim(Cells(j, 2)) 
        If Asc(Right(a, 1)) <> AscW(Right(a, 1)) Then'如果最后一位是汉字,则选择其为单位
        Cells(j, 4) = Right(a, 1)
        Else'如果不为汉字(为字母)
        If VBA.IsNumeric(Mid(a, Len(a) - 1, 1)) Then'当倒数第二位为数字时
        Cells(j, 4) = Right(a, 1)
        Else: Cells(j, 4) = Right(a, 2)'如果不为数字则选两位
        End If
        End If
              
    For i = 1 To Len(a) - 1
    If Asc(Mid(a, i, 1)) <> AscW(Mid(a, i, 1)) And Asc(Mid(a, i + 1, 1)) = AscW(Mid(a, i + 1, 1)) And Asc(Mid(a, i + 1, 1)) > 1 Then
    Cells(j, 2) = IIf(AscW(Mid(a, i, 1)) = 1060, Left(a, i - 1), Left(a, i)): Exit For'红色部分为希腊字母,可用or语句来添加.
    End If
    Next i
    On Error Resume Next
    Cells(j, 3) = Mid(a, Len(Cells(j, 2)) + 1, Len(a) - Len(Cells(j, 2)) - Len(Cells(j, 4)))
    Next j
End Sub

缺陷:当型号最后一位与单位一样为字母时,就无法识别了,因为就没有规律了~

ggmmlol

adaigua 发表于 2007-9-2 10:38
参考上述两位高手的现在给出完善答案：考虑单位有可能是汉字、字母（汉字为一位、字母可能有两位）；而名称 ...

这种问题，用正则表达式工具，那是手到擒来：

1. Sub ggmmlol()
   
2.     Set reg = CreateObject("VBScript.RegExp")
   
3.     r = Cells(Rows.Count, 1).End(xlUp).Row
   
4.     ar = [a1].Resize(r)
   
5.     ReDim br(2 To r, 0 To 2)
   
6.     reg.Global = True
   
7.     reg.Pattern = "^(.*?[一-龥]+)(.*?)([一-龥]+|[A-Za-z]+)$"
   
8.     For i = 2 To r
   
9.         tmp = Split(reg.Replace(ar(i, 1), "$1|$2|$3"), "|")
   
10.         For j = 0 To 2
    
11.             br(i, j) = tmp(j)
    
12.         Next
    
13.     Next
    
14.     [b2].Resize(r - 1, 3) = br
    
15. End Sub

复制代码