- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2014-1-21 14:55
| 只看該作者
本帖最後由 GBKEE 於 2014-1-22 14:52 編輯
回復 1# li_hsien
改用 Collection 物件 不用 Dictionary 物件- Option Explicit
- Sub Ex()
- Dim d As New Collection, AR(1 To 7), i As Integer, Rng(1 To 2) As Range, E As Variant
- On Error Resume Next '註解1 :Collection新增的KEY如被使用或有錯誤
- With Worksheets("產品管控清單")
- For i = 2 To .Range("J1").End(xlDown).Row
- AR(1) = .Range("E" & i) 'PRODUCT ID(A)
- AR(2) = .Range("F" & i) 'CHILDPARTNUMBER(B)
- AR(3) = .Range("C" & i) 'MP date(G)
- AR(4) = .Range("A" & i) '週別(H)
- AR(5) = .Range("B" & i) '更新週別(I)
- AR(6) = DateDiff("d", Date, AR(3)) '工作日(M)
- AR(7) = .Range("J" & i) 'Product ID & PartNumber
- d.Add AR, .Range("J" & i).Value '紀錄產品的ID & PartNumber
-
- '**** 所以是以"產品"擁有的為主，不過產出"物料"之前得先刪除"產品"重複的部分->Rng(1)
- '**** 當產品的ID & PartNumber(F)有重複時有->註解1: Err <> 0
- If Err <> 0 Then
- Err.Clear
- If Rng(1) Is Nothing Then 'Rng(1)->紀錄有重複產品的ID & PartNumber
- Set Rng(1) = .Range("J" & i)
- Else
- Set Rng(1) = Union(.Range("J" & i), Rng(1))
- End If
- End If
- Next
- End With
- With Worksheets("物料管控清單")
- For Each E In .Range("F:F").SpecialCells(xlCellTypeConstants).Offset(1)
- .Range("A" & E.Row) = d(E.Value)(1)
- .Range("B" & E.Row) = d(E.Value)(2)
- .Range("G" & E.Row) = d(E.Value)(3)
- .Range("H" & E.Row) = d(E.Value)(4)
- .Range("I" & E.Row) = d(E.Value)(5)
- .Range("M" & E.Row) = d(E.Value)(6)
- .Range("F" & E.Row) = d(E.Value)(7)
-
- '**** "產品"有 "物料"有 則把 "產品" 的資料COPY到 "物料" 原本的位子上
- '**** 產品"有 "物料"有 -> Err = 0
- If Err = 0 Then '物料的ID & PartNumber,存在產品的ID & PartNumber中
- d.Remove E.Value '除去:產品的ID & PartNumber
- '**** 有第二筆已除去的產品ID & PartNumber-> 已除去(沒有這KEY值): Err <> 0
- ElseIf Err <> 0 And E <> "" Then
- '**** "產品"沒有 "物料"有 則把"物料"整欄刪除掉 -> Rng(2)
- If Rng(2) Is Nothing Then '取的儲存格的位置
- Set Rng(2) = E
- Else
- Set Rng(2) = Union(E, Rng(2))
- End If
- End If
- Err.Clear
- Next
- If d.Count > 0 Then
-
- 'C ***產品"有 "物料"沒有 則把新增多出來的增加到 "物料" 最下面
- i = 0
- With .Range("A1").End(xlDown)
- For Each E In d
- i = i + 1
- .Offset(i).Range("A1") = E(1)
- .Offset(i).Range("B1") = E(2)
- .Offset(i).Range("G1") = E(3)
- .Offset(i).Range("H1") = E(4)
- .Offset(i).Range("I1") = E(5)
- .Offset(i).Range("M1") = E(6)
- .Offset(i).Range("F1") = E(7)
- Next
- End With
- End If
- End With
- If Not Rng(1) Is Nothing Then
- '**** 刪除"產品"重複的部分->Rng(1)
- If MsgBox("刪除重複的[ID & PartNumber]", vbQuestion + vbYesNo, "產品管控清單") = vbYes Then
- Rng(1).EntireRow.Delete
- End If
- End If
-
- If Not Rng(2) Is Nothing Then
- '**** "產品"沒有 "物料"有 則把"物料"整欄刪除掉 -> Rng(2)
- If MsgBox("刪除重複的[ID & PartNumber]", vbQuestion + vbYesNo, "物料管控清單") = vbYes Then
- Rng(2).EntireRow.Delete
- End If
- End If
- MsgBox "Ok"
- End Sub
|
|
發表於 2014-1-21 17:48
| 
