|
紅色部份,新增編碼排序條件
Sub a()
Dim dic As Object, reg As Object, arr, brr, i&, k, ma
Set dic = CreateObject("scripting.dictionary")
Set reg = CreateObject("vbscript.regexp")
arr = Sheet1.Range("d1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 3)
Sheet2.Range("d:f").ClearContents
Set List = CreateObject("System.Collections.ArrayList")
For i = 2 To UBound(arr)
dic(arr(i, 12)) = i
List.Add(arr(i,10) & arr(i, 12) & vbTab & arr(i, 12))
Next
List.Sort
Set dic2 = CreateObject("scripting.dictionary")
For Each Key In List
s = Split(Key, vbTab)
dic2(s(1)) = ""
Next
k = dic2.keys
brr(1, 1) = "客户": brr(1, 2) = "编码": brr(1, 3) = "规格"
For i = 0 To dic.Count - 1
brr(i + 2, 2) = k(i): brr(i + 2, 1) = arr(dic(k(i)), 10)
With reg
.Global = 1
.Pattern = ".+V"
Set ma = .Execute(arr(dic(k(i)), 15))
End With
If ma.Count > 0 Then
brr(i + 2, 3) = ma(0)
Else
brr(i + 2, 3) = arr(dic(k(i)), 15)
End If
Next
Sheet2.Range("d3").Resize(UBound(brr), 3) = brr
End Sub
祝順心,南無阿彌陀佛!
|
|