- 帖子
- 262
- 主題
- 8
- 精華
- 0
- 積分
- 280
- 點名
- 17
- 作業系統
- xp
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- HK
- 註冊時間
- 2015-8-11
- 最後登錄
- 2024-11-19
|
試一下單字典方法- Sub zz()
- Dim a, d As Object, c!, e!, b(9), ar, br, tr, kr, k, t, n&, kk, tt
- If [T7] = "" Then Exit Sub
- [x6].CurrentRegion.Offset(4).Clear
- Set d = CreateObject("scripting.dictionary")
- c = [ac4]
- e = [ac5]
- a = [n6].CurrentRegion
- ar = Array(8, 7, 6, 5)
- br = Array(0, 1, 3, 5)
- For i = 2 To UBound(a)
- k = a(i, 7)
- If Len(a(i, 2)) Then
- kk = k & "|" & a(i, 2)
- If Not d.exists(kk) Then
- d(kk) = Array(a(i, 3), a(i, 4))
- Else
- t = d(kk)
- t(0) = t(0) + a(i, 3)
- d(kk) = t
- End If
- End If
- b(8) = Join(Array(a(i, 1), a(i, 3), a(i, 4)), " ")
- For j = 0 To UBound(br)
- b(br(j)) = a(i, ar(j))
- Next
- b(2) = 1
- If Not d.exists(k) Then
- d(k) = b
- Else
- t = d(k)
- n = 0
- t(2) = t(2) + 1
- For Each j In Array(3, 5)
- t(j) = t(j) + b(j)
- n = n + 1
- Next
- t(8) = t(8) & ", " & b(8)
- d(k) = t
- End If
- Next
- For i = 2 To UBound(a)
- If Len(a(i, 2)) Then
- k = a(i, 7)
- kk = k & "|" & a(i, 2)
- If d.exists(kk) Then
- t = d(k)
- tt = d(kk)
- t(9) = t(9) & ", " & Join(Array(a(i, 2), tt(0), tt(1)))
- d.Remove (kk)
- d(k) = t
- End If
- End If
- Next
- t = d.items
- ReDim br(1 To d.Count, 1 To 10)
- ar = Array("PUMP MOTOR", "TOOLING")
- For i = 0 To UBound(t)
- k = t(i)
- For j = 0 To UBound(k)
- br(i + 1, j + 1) = k(j)
- Next
- br(i + 1, 5) = Round(br(i + 1, 4) / e * c, 0)
- n = IIf(InStr(br(i + 1, 10), "TOOLING"), 10, 2)
- br(i + 1, 7) = br(i + 1, 6) + br(i + 1, 3) * n
- br(i + 1, 10) = Mid(br(i + 1, 10), 3)
- For jj = 0 To UBound(ar)
- If InStr(br(i + 1, 10), ar(jj)) Then br(i + 1, 8) = ar(jj)
- Next
- If br(i + 1, 8) = "" Then br(i + 1, 8) = "MACHINE ACCESSORY"
- Next
- [x7].Resize(i, j) = br
- [x7].Resize(i, j).Borders.Weight = 1
- End Sub
|
|
發表於 2019-10-3 13:15
| 
發表於 2019-10-3 13:34
| 
