|
发表于 2012-5-4 09:31
|
显示全部楼层
本楼为最佳答案
- Sub KD()
- Dim R As New RegExp, Ar, Arr, i&
- Dim An(1 To 99) As Long, K&, At(), Cel As Range
- Const CN As Double = 25.4
- Set Cel = Range("A:a").Find("%")
- Range("b2:d" & Rows.Count).ClearContents
- If Not Cel Is Nothing Then
- Ar = Range("A2:A" & Cel.Row - 1).Value
- Arr = Range(Cel.Offset(1), Cel.End(4)).Value
- ReDim At(1 To UBound(Ar), 1 To 3)
- With R
- .Global = True
- .Pattern = ".*X.*Y.*"
- For i = 1 To UBound(Arr)
- If Left(Arr(i, 1), 1) = "T" Then
- K = CByte(Mid(Arr(i, 1), 2))
- Else
- If .Test(Arr(i, 1)) Then
- An(K) = An(K) + 1
- End If
- End If
- Next i
- .Pattern = "(T(\d{2}))C(\.\d+)$"
- For i = 1 To UBound(Ar)
- If .Test(Ar(i, 1)) Then
- Arr = Split(.Replace(Ar(i, 1), "$1 $3 $2"))
- At(i, 1) = Arr(0)
- At(i, 2) = Arr(1) * CN
- At(i, 3) = An(CByte(Arr(2)))
- End If
- Next i
- End With
- [b2].Resize(UBound(At), 3) = At
- Set R = Nothing
- MsgBox "处理完毕,请验证。"
- End If
- End Sub
复制代码
Book29.rar
(18.57 KB, 下载次数: 7)
|
|