帖子: 13
主題: 3
精華: 0
積分: 50
點名: 0
作業系統: windows7
軟體版本: office2003
閱讀權限: 20
性別: 男
註冊時間: 2012-12-15
最後登錄: 2013-2-9

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2012-12-20 17:11 | 只看該作者

[發問] EXCEL 比對資料問題

小弟參照網站上寫的程式修改
在此compareab_V3 的路徑裡面修改了一下
資料A和資料B ,設置一個按鈕更新前週和當週的資料自動開另二個EXCEL 2 & 3 的其中(B、C、L、O、)欄抓出來比對

但操作方面的程式碼太複雜....剛學VBA不太懂  (網路上抓的我只增加資料A和B的按鈕可以叫出資料來源)
是否有簡化的公式  :
我想要的是:
1.顏色差異性:比對在資料A和資料B  標出紅色差異性
2.比對後只留不同的資料出來,相同的資料不留 (因為是Parts管理,所以只會有ON Hand 數量會變 ,想讓它帶出來後知道此[Parts00X ,品名,  ON Hand( 呈現的增加或減少)  ,    價格 ]
講白了就是:另一頁資料A  ON Hand數量為2  當資料B變為 0時比對在新的Sheet待出-2
                     另一頁資料A  ON Hand數量為2  當資料B變為 4時比對在新的Sheet待出+2 or 2
是否有機會做到此功能

3.如我我更改我的資料A和資料B 設置一個按鈕更新前週和當週的資料自動開另二個EXCEL 2 & 3 的其中(B、C、L、O、P)欄抓出來比對
其中資料A和資料B 想見一個按鈕待出    單存比對O、P 完後的資料為
另一頁          資料A  ON Hand數量為2       當資料B安全庫存變為 1時比對在新的Sheet待出-1
                     另一頁資料A  ON Hand數量為2    當資料B安全庫存變為 4時大於ON Hand 2 則不帶出來

是否有機會做到此功能

compareab_v3.rar (582.4 KB)

2.rar (16.45 KB)

3.rar (16.43 KB)

樓主熱帖

神無法侵犯的世界

tmde987

中學生 Rank: 2

帖子: 13
主題: 3
精華: 0
積分: 50
點名: 0
作業系統: windows7
軟體版本: office2003
閱讀權限: 20
性別: 男
註冊時間: 2012-12-15
最後登錄: 2013-2-9

4^#

發表於 2012-12-22 14:06 | 只看該作者

上面的指令有人會嗎?請幫忙教一下謝謝!!

神無法侵犯的世界

TOP

tmde987

中學生 Rank: 2

帖子: 13
主題: 3
精華: 0
積分: 50
點名: 0
作業系統: windows7
軟體版本: office2003
閱讀權限: 20
性別: 男
註冊時間: 2012-12-15
最後登錄: 2013-2-9

3^#

發表於 2012-12-21 11:28 | 只看該作者

本帖最後由 tmde987 於 2012-12-21 11:30 編輯

感謝樓上幫我解第一個問題,另外可否改成只帶出資料A與B差異性變顏色,資料A缺少的,資料B缺少的
而不帶出A與B都有的程式 (標示差異性顏色比對)

我重新敘述一下第二和第三個問題

第二個問題是希望能建立一個程式鈕，此鈕能在新的SHEET開啟比對
比對後只留不同的資料出來,相同的資料不留  假設會變動的只有欄C ON Hand
舉下面例子來說今天只有Part3 ON Hand 改變則比對A & B 後帶出如下紅字

  欄A          欄B          欄C             欄D
[Parts00X ,品名, ON Hand(B-A )  ,    價格 ]
當相同Parts3 在資料A ON Hand為3 在資料B ON Hand為1 相減有差異
則帶出比對差異性來標示為-2

當相同Parts5 在資料A ON Hand為6 在資料B ON Hand為6 相減為0差異
則不帶出來
[Parts3  ,鹵素杯燈, -2[Parts5 , 500]

第三個問題是說假設今天比對增加第E欄
稍微修改一下資料B的 5的程式讓她帶出  Excel 3 的其中(B、C、O、P、L)  原本只有帶出(B、C、O、L)
想建立一個比對鈕比對資料B 在一個新的SHeet
其出來的差異為下
欄A             欄B                      欄C                            欄D
PArts          品名       目前安全庫存-On HAND (資料B)    價格

假設今天資料B的如下
Parts3  On HAND 7 目前安全庫存 5
Parts4  On HAND 1 目前安全庫存 1
Parts5  On HAND 2 目前安全庫存 6
則帶出比對資料在一個新的Sheet為
[Parts3 鹵素杯燈    2    $500 ]
[Parts5  FUSE 5A 250V  -4    $500    ]
※Part4相減為0無差異不被帶出

神無法侵犯的世界

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

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

2^#

發表於 2012-12-21 09:41 | 只看該作者

回復 1# tmde987
對於你的說明,不很了解,試看看是這方向嗎?

Sub CommandButton4_Click()
With Workbooks.Open("C:\Documents and Settings\901755\桌面\捷徑(含manual)\2.xls")
.Sheets(1).Range("B:C,O:O").Copy Workbooks("compareab_v3.xls").Sheets("資料A").Range("A1")
.Sheets(1).Range("L:L").Copy Workbooks("compareab_v3.xls").Sheets("資料A").Range("D1")
.Close
End With
End Sub

複製代碼

Sub CommandButton5_Click()
'Workbooks.Open Filename:="C:\Documents and Settings\901755\桌面\捷徑(含manual)\3.xls"
With WorkbooksOpen("C:\Documents and Settings\901755\桌面\捷徑(含manual)\3.xls")
.Sheets(1).Range("B:C,O:O").Copy Workbooks("compareab_v3.xls").Sheets("資料B").Range("A1")
.Sheets(1).Range("L:L").Copy Workbooks("compareab_v3.xls").Sheets("資料B").Range("D1")
.Close
End With
End Sub

複製代碼

Option Explicit
Sub Ex_資料比對()
Dim D As Object, Rng As Range, K As Variant, Msg As Boolean, xi As Integer
Set D = CreateObject("SCRIPTING.DICTIONARY")
Sheets("資料A").Cells.Font.ColorIndex = 0
Sheets("資料B").Cells.Font.ColorIndex = 0
Sheets("資料A缺少的").Cells.Clear
Sheets("資料B缺少的").Cells.Clear
Set Rng = Sheets("資料A").[A1]
Do While Rng <> ""
Set D(Rng & Rng(1, 2)) = Rng.Resize(, 4)
Set Rng = Rng.Offset(1)
Loop
Set Rng = Sheets("資料B").[A2]
Do While Rng <> ""
Msg = False
If D(Rng & Rng(1, 2)).Cells(3) <> Rng(1, 3) Then
Msg = True
D(Rng & Rng(1, 2)).Cells(3).Font.Color = vbRed
Rng(1, 3).Font.Color = vbRed
End If
If D(Rng & Rng(1, 2)).Cells(4) <> Rng(1, 4) Then
Msg = True
D(Rng & Rng(1, 2)).Cells(4).Font.Color = vbRed
Rng(1, 4).Font.Color = vbRed
End If
If Msg = True Then
xi = xi + 1
Sheets("資料A缺少的").Cells(xi, "a").Resize(1, 4) = D(Rng & Rng(1, 2)).Value
Sheets("資料B缺少的").Cells(xi, "a").Resize(1, 4) = Rng.Resize(1, 4).Value
Else
D.Remove (Rng & Rng(1, 2))
End If
Set Rng = Rng.Offset(1)
Loop
With Sheets("資料A與B都有的")
If D.Count > 0 Then
.Cells.Clear
xi = 1
For Each K In D.KEYS
.Cells(xi, "a").Resize(1, 4) = D(K).Value
xi = xi + 1
Next
End If
End With
End Sub

複製代碼

TOP