- Sub 数据分类整理()
- Dim arr, i%, a(), k%, m%, n%, s$, d As Object
- Set d = CreateObject("scripting.dictionary")
- arr = Sheet1.Range("A3").CurrentRegion
- For i = 2 To UBound(arr)
- s = arr(i, 2) & "|" & arr(i, 3)
- If Not d.Exists(s) Then
- k = k + 1
- m = k: d(s) = k
- ReDim Preserve a(1 To 6, 1 To k)
- a(1, m) = arr(i, 1) '项目名称
- a(2, m) = arr(i, 2) '图号
- a(3, m) = arr(i, 3) '产品名称
- Else
- m = d.Item(s)
- End If
-
- If arr(i, 3) = "门连套" Then
- If InStr(arr(i, 4), "套板") Then
- a(5, m) = arr(i, 5) '深(D)
- ElseIf InStr(arr(i, 4), "线条") Then
- a(4, m) = arr(i, 5) '长(W)
- a(6, m) = arr(i, 7) '高(H)
- End If
- ElseIf arr(i, 3) = "衣柜" Then
- If arr(i, 4) = "柜体" Then
- a(5, m) = arr(i, 6) '深(D)
- ElseIf InStr(arr(i, 4), "线条") Then
- a(4, m) = arr(i, 5) '长(W)
- a(6, m) = arr(i, 7) '高(H)
- End If
- Else
- a(4, m) = arr(i, 5) '长(W)
- a(5, m) = arr(i, 6) '深(D)
- a(6, m) = arr(i, 7) '高(H)
- End If
-
- Next
- Sheet2.Range("H4").Resize(m, 6) = WorksheetFunction.Transpose(a)
- End Sub
复制代码 |