[發問] 改善大筆資料處理

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 248
主題: 55
精華: 0
積分: 314
點名: 82
作業系統: XP / WIN7
軟體版本: 2003 / 2007
閱讀權限: 20
性別: 男
來自: Tainan
註冊時間: 2013-10-18
最後登錄: 2024-4-20

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇贊助勳章 2014馬年全勤獎章 2015羊年全勤獎章熱烈參與勳章

3^#

發表於 2014-1-21 15:24 | 只看該作者

回復 2# GBKEE

板大我發現了一點問題

我如果在產品那邊刪掉一筆

在物料那並沒有刪除掉

新增加的話還OK

最後板大幫我設置的刪除提示

為什麼刪掉後只剩下4.5筆呀???

我用2007的移除重複，並沒有這麼多重複

不知問題出在哪裡???

麻煩幫我看看

謝謝 : )

用功到世界末日那一天～～～

帖子: 248
主題: 55
精華: 0
積分: 314
點名: 82
作業系統: XP / WIN7
軟體版本: 2003 / 2007
閱讀權限: 20
性別: 男
來自: Tainan
註冊時間: 2013-10-18
最後登錄: 2024-4-20

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇贊助勳章 2014馬年全勤獎章 2015羊年全勤獎章熱烈參與勳章

4^#

發表於 2014-1-21 17:48 | 只看該作者

回復 2# GBKEE

謝謝大大的幫忙

可是我發現還是沒有刪除掉耶

產品沒有的，物料那邊還是有出現

我是在產品中間隨便刪一筆測試的

那大大的重複提示

我用2007內建的移除重複測試

發現還是多刪了，可是筆數不多

我要留有重複的第一筆
EX:
A,B,C,A,A,B,C,D
我要留A,B,C,D

不知大大是不是把重複的都刪了

麻煩幫我看看感謝 : )

用功到世界末日那一天～～～

帖子: 248
主題: 55
精華: 0
積分: 314
點名: 82
作業系統: XP / WIN7
軟體版本: 2003 / 2007
閱讀權限: 20
性別: 男
來自: Tainan
註冊時間: 2013-10-18
最後登錄: 2024-4-20

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇贊助勳章 2014馬年全勤獎章 2015羊年全勤獎章熱烈參與勳章

5^#

發表於 2014-1-21 21:24 | 只看該作者

回復 2# GBKEE

版大我又出現了@@

我試了一試還是怪怪的耶

產品如果在資料中有新增

好像抓不到物料那邊

會怪怪的

還是只能在最下面新增

如果我在產品的資料中刪除一筆

物料那邊還是會出現@@

本身有2007的關係
我驗證資料重複應該剩下1026筆
物料那邊OK 不過產品那邊還是不一致

又再次麻煩大大了

謝謝你 : )

用功到世界末日那一天～～～

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2014-1-22 10:33 | 只看該作者

回復 5# li_hsien
[A,B,C,A,A,B,C,D我要留A,B,C,D]

d.Add AR, .Range("J" & i).Value
'****** A,B,C,A,A,B,C,D我要留A , B, C,D.. 這裡在處理.
If Err <> 0 Then '錯誤: 產品重複的[ID & PartNumber]
Err.Clear
If Rng(1) Is Nothing Then '紀錄:產品重複的[ID & PartNumber]的位置
Set Rng(1) = .Range("J" & i)
Else
Set Rng(1) = Union(.Range("J" & i), Rng(1))
End If
End If

複製代碼

[產品沒有的，物料那邊還是有出現]

'******* 我如果在產品那邊刪掉一筆,在物料那並沒有刪除掉??這裡有作處裡
If Err = 0 Then '物料的ID & PartNumber,有存在產品的ID & PartNumber中
d.Remove E.Value '除去:產品的ID & PartNumber
Else '-> Err <> 0 有錯誤
'錯誤1:已除去產品的ID & PartNumber
'錯誤2:物料的ID & PartNumber,不存在產品的ID & PartNumber中
If Rng(2) Is Nothing Then '紀錄儲存格的位置
Set Rng(2) = E
Else
Set Rng(2) = Union(E, Rng(2)) '紀錄儲存格的位置
End If
End If
'*********************************************************
Err.Clear

複製代碼

請上傳測試的檔案看看

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 248
主題: 55
精華: 0
積分: 314
點名: 82
作業系統: XP / WIN7
軟體版本: 2003 / 2007
閱讀權限: 20
性別: 男
來自: Tainan
註冊時間: 2013-10-18
最後登錄: 2024-4-20

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇贊助勳章 2014馬年全勤獎章 2015羊年全勤獎章熱烈參與勳章

7^#

發表於 2014-1-22 11:00 | 只看該作者

回復 6# GBKEE

我都是直接再次COPY過去

剛剛再次確認

新增應該OK

不過好像都是要按下MSGBOX確認後才可以

可是移除後數量不對

附檔還有兩張圖

一張是原有資料

另一張是用了移除重複後的資料

煩請大大幫我看看

forum.zip (256.48 KB)

用功到世界末日那一天～～～

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2014-1-22 11:58 | 只看該作者

本帖最後由 GBKEE 於 2014-1-22 12:02 編輯

回復 7# li_hsien

7#的檔案,執行2#的程式碼

找出物料管控清單 (產品沒有或物料重複)的ID

1194同列為產品管控清單,物料管控清單的最後一筆資料

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 248
主題: 55
精華: 0
積分: 314
點名: 82
作業系統: XP / WIN7
軟體版本: 2003 / 2007
閱讀權限: 20
性別: 男
來自: Tainan
註冊時間: 2013-10-18
最後登錄: 2024-4-20

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇贊助勳章 2014馬年全勤獎章 2015羊年全勤獎章熱烈參與勳章

9^#

發表於 2014-1-22 14:09 | 只看該作者

回復 8# GBKEE

板大我再測試了一下

在物料或是產品的工作表執行應該都沒有差別吧

我不太懂第一次刪除重複的動作

因為附檔的資料一開始在"產品"那邊有1801項，"物料"那邊有1206項

我先用移除重複篩一次"產品"那邊的項目，只剩下1206項

可是我用了程式跑只剩下1196項

應該是多刪了板大圖示的部分

我的處理流程是先依據"產品"裡的來產出"物料"裡面的

動作是如果 (都是以ID & PART NUMBER為依據)
"產品"有 "物料"有則把 "產品" 的資料COPY到 "物料" 原本的位子上
"產品"有 "物料"沒有則把新增多出來的增加到 "物料" 最下面
"產品"沒有 "物料"有則把"物料"整欄刪除掉

所以是以"產品"擁有的為主，不過產出"物料"之前得先刪除"產品"重複的部分

最後結果是"產品"跟"物料"的項目數會是一樣的沒有錯

不過就在一開始的移除有些問題

做過第一次動作後，我再測試刪刪減減這些動作，都很順利沒有問題 : )

有點冗長@@

煩請板大看看

謝謝

用功到世界末日那一天～～～

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

10^#

發表於 2014-1-22 14:30 | 只看該作者

回復 9# li_hsien
2#的程式請你修改一下看看產品管控清單重複的ID

'********* "產品管控清單" 刪除重複的[ID & PartNumber]*******************
If Not Rng(1) Is Nothing Then
If MsgBox("刪除重複的[ID & PartNumber]", vbQuestion + vbYesNo, "產品管控清單") = vbYes Then
Worksheets("產品管控清單").Activate
Stop '程式會停止按F8一步一步執行下去看工作表的情形
Rng(1).EntireRow.Select '選取重複的ID
MsgBox Rng(1).EntireRow.Address
Rng(1).EntireRow.Delete '先註解掉不刪除
End If
End If

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.