楼主
liuguansky |
Q:如何把产品的型号产地数量明细，按型号产地的数量层次编码表返回编码？
A:用如下代码可以实现：- Sub 编码()
- Dim Ar, arr, i&, d, s$, Arrt() As String, j As Byte
- '定义变量
- Set d = CreateObject("scripting.dictionary")
- '创建字典项目
- Ar = Range("H2:U5").Value
- '引用编码信息数据
- For i = 1 To UBound(Ar, 1) '编码信息赋予字典项目
- s = Ar(i, 1) & Ar(i, 2)
- d(s) = Array(i, 0) '行号作为标识位
- Next i
- For i = 1 To UBound(Ar, 1) '重新循环，返回编码数量限定的累加
- For j = 6 To UBound(Ar, 2) Step 2
- If Ar(i, j) <> "" Then
- Ar(i, j) = Ar(i, j - 2) + Ar(i, j)
- End If
- Next j, i
- arr = Range("b2:d" & Cells(Rows.Count, 1).End(3).Row).Value
- '获取待处理数据源
- ReDim Arrt(1 To UBound(arr, 1), 1 To 1)
- '定义结果数组
- For i = 1 To UBound(arr, 1) '循环数据源
- s = arr(i, 1) & arr(i, 2) '获取惟一标识字符串
- If d.exists(s) Then '如果存在
- d(s) = Array(d(s)(0), d(s)(1) + arr(i, 3)) '进行数量累加
- For j = 4 To UBound(Ar, 2) Step 2 '循环编码数量
- Rem 此时的循环的数量已为累加数量
- If Len(Ar(d(s)(0), j)) = 0 Then
- '如果数量不存在，则直接返回最后编码，同时跳出循环
- Arrt(i, 1) = Ar(d(s)(0), j - 3)
- Exit For
- End If
- If d(s)(1) <= Ar(d(s)(0), j) Then '如果不大于当前累加数量，则返回当段编码
- Arrt(i, 1) = Ar(d(s)(0), j - 1)
- Exit For '跳出循环
- End If
- Next
- End If
- Next i
- Range("e2:e" & Rows.Count).ClearContents
- Range("e2").Resize(UBound(Arrt, 1), 1) = Arrt '返回结果
- Set d = Nothing
- End Sub
|