|
楼主 |
发表于 2011-9-27 08:47
|
显示全部楼层
本帖最后由 yiyiyicz 于 2011-9-27 08:54 编辑
一次提取符合要求的产品编码
http://club.excelhome.net/forum.php?mod=viewthread&tid=712496
编码特点是:10位编码中,前4位相同,
类似于分级编码,各级编码赋值后,写成一串码。这时在检索时需要分辨层级
Sub Macro1()
Dim d As Object, arr, brr(), crr(), lc$, i&, m&, s$
Set d = CreateObject("scripting.dictionary")
arr = Sheets("数据源").Range("A1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 255)
ReDim crr(UBound(arr))
For i = 2 To UBound(arr)
If Left(arr(i, 3), 4) = "0727" Or Left(arr(i, 3), 4) = "0754" Then
s = arr(i, 2)
If Not d.Exists(s) Then
m = m + 1
d(s) = m
brr(m, 1) = s
brr(m, 2) = arr(i, 3)
Else
crr(d(s)) = crr(d(s)) + 1
lc = IIf(crr(d(s)) > lc, crr(d(s)), lc)
brr(d(s), crr(d(s)) + 2) = arr(i, 3)
End If
End If
Next
ActiveSheet.UsedRange.Offset(1).ClearContents
[b2].Resize(m, lc + 2) = brr
End Sub
《zhaogang1960 编写》
|
|