帖子: 9
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: Office 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-2-22
最後登錄: 2015-5-14

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2013-2-22 21:34 | 只看該作者

[發問] 比較資料-利用VBA程式比較兩個資料檔案並做計算

麻煩各位大大：
以下不知有誰會呢？可以教我嗎？
檔案A
規格  數量
AAA  20
BBB 35
CCC  42
DDD 10
檔案B
規格  數量
AAA  20
BBB 30
CCC  46
DDD 10
就是有兩個檔案內容分別如上，希望能夠按一個按鈕，
1.先將兩個檔案分別放在同一檔案不同的工作表
2.再將比較結果放在第三個工作表，顯示如下：
規格  數量規格  數量規格  差異數
AAA  20    AAA  20    AAA    0
BBB 30    BBB 35    BBB       5  (儲存格用紅色顯示)
CCC  42    CCC  46    CCC    -6  (儲存格用紅色顯示)
DDD 10    DDD 10    DDD    0

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 267
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2013-2-22 22:33 | 只看該作者

回復 1# amychlo

將程式碼放在彙整的活頁簿一般模組

Sub 彙整()
Set d = CreateObject("Scripting.Dictionary")
fd = ThisWorkbook.Path & "\" '3個檔案放在同目錄中
'fd="D:\" '指定A、B2檔案的存放目錄
fs = Array("A.xls", "B.xls")
d("規格") = "數量"
For Each f In fs
With Workbooks.Open(fd & f)
With .Sheets(1)
i = i + 1
.UsedRange.Copy ThisWorkbook.Sheets(i).[A1]
With ThisWorkbook.Sheets(i)
For Each a In .Range(.[A2], .[A2].End(xlDown))
If IsEmpty(d(a.Value)) Then d(a.Value) = a.Offset(, 1) Else d(a.Value) = a.Offset(, 1) - d(a.Value)
Next
End With
End With
.Close
End With
Next
With Sheets(3)
.[A1].Resize(d.Count, 1) = Application.Transpose(d.keys)
.[B1].Resize(d.Count, 1) = Application.Transpose(d.items)
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

amychlo

中學生 Rank: 2

帖子: 9
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: Office 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-2-22
最後登錄: 2015-5-14

3^#

發表於 2013-2-23 19:35 | 只看該作者

大大請問一下：
1.您所說的一般模組是在Module下嗎？
2.放在模組下，不用建按鈕觸發嗎？
不好意思！
因為剛接觸vba所以一切還在摸索中，
請您多多指教囉！
感恩

TOP

kimbal

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

4^#

發表於 2013-2-28 13:46 | 只看該作者

大大請問一下：
1.您所說的一般模組是在Module下嗎？
2.放在模組下，不用建按鈕觸發嗎？
不好意思！
因 ...
amychlo 發表於 2013-2-23 19:35

1. 對
2.不建按鈕的話,
在module上點上任何一行, 按keyboard "F5"鍵可
或在excel頁面 "開發人員"菜單->巨集->選上sub ->執行

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

amychlo

中學生 Rank: 2

帖子: 9
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: Office 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-2-22
最後登錄: 2015-5-14

5^#

發表於 2013-3-7 19:50 | 只看該作者

回復 2# Hsieh

感恩大大的回應！
(3/2)後來提問的問題是：
A.xls
項次  規格  單位  單價  數量
1    AA1 pcs 10 300
2    AB2 pcs    20 35
3    AC1 pcs    18 0
4    AD2 pcs    10 52
5    AE3 pcs    15 200
B.xls
項次  規格  單位  數量
1    A1    pcs 300
2    B2    pcs    40
3    E3    pcs    150
1.首先先將A、B兩個檔案分別放在同一個檔案、不同的工作表
A、B兩個檔案的[規格]是相同的，
只是當初在建A檔案時在每一個規格的第一碼加了一碼"A"，
其餘後方的都相同。
2.再將比較結果放在第三個工作表，顯示如下：
(希望在第三個工作表也能將A、B兩檔案顯示出來)
規格  數量規格  數量    規格  差異數(B.xla-A.xls)
A1    300    A1    300    A1    0
B2    35       B2    40       B2    5
C1    0       E3    150    C1    0
D2 52                               D2    -52
E3    200                            E3    -50

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 267
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2013-3-7 21:07 | 只看該作者

回復 5# amychlo
昨天因為論壇的磁碟陣列出問題，遺失了資料，重新回復

Sub 彙整()
Dim Ar()
Set d = CreateObject("Scripting.Dictionary")
fd = ThisWorkbook.Path & "\" '3個檔案放在同目錄中
'fd="D:\" '指定A、B2檔案的存放目錄
fs = Array("A.xls", "B.xls")
d("規格") = "數量"
For Each f In fs
With Workbooks.Open(fd & f)
With .Sheets(1)
i = i + 1
ReDim Preserve Ar(2, s)
Ar(0, s) = "規格": Ar(1, s) = "數量"
s = s + 1
.UsedRange.Copy ThisWorkbook.Sheets(i).[A1]
With ThisWorkbook.Sheets(i)
For Each a In .Range(.[B2], .[B2].End(xlDown))
If IsEmpty(d(Right(a, 2))) Then d(Right(a, 2)) = a.Offset(, IIf(i = 1, 3, 2)) Else d(Right(a, 2)) = a.Offset(, IIf(i = 1, 3, 2)) - d(Right(a, 2))
ReDim Preserve Ar(2, s)
Ar(0, s) = Right(a, 2): Ar(1, s) = a.Offset(, IIf(i = 1, 3, 2)).Value
s = s + 1
Next
Sheets(3).[A1].Offset(, (i - 1) * 2).Resize(s, 2) = Application.Transpose(Ar)
Erase Ar: s = 0
End With
End With
.Close
End With
Next
With Sheets(3)
.[E1].Resize(d.Count, 1) = Application.Transpose(d.keys)
.[F1].Resize(d.Count, 1) = Application.Transpose(d.items)
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

amychlo

中學生 Rank: 2

帖子: 9
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: Office 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-2-22
最後登錄: 2015-5-14

7^#

發表於 2013-3-16 19:14 | 只看該作者

回復 6# Hsieh

大大：
感恩您的回復！
但我試了幾天還是改不出我要的狀況，
所以現在就把我的原始檔壓縮上傳，
再麻煩您看看！
感恩！

A.rar (6.78 KB)

B.rar (4.78 KB)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 267
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

8^#

發表於 2013-3-16 22:56 | 只看該作者

回復 7# amychlo
試試看

Sub 彙整()
Dim Ar()
Set d = CreateObject("Scripting.Dictionary")
fd = ThisWorkbook.Path & "\" '3個檔案放在同目錄中
'fd="D:\" '指定A、B2檔案的存放目錄
fs = Array("A.xls", "B.xls")
d("規格") = "數量"
For Each f In fs
With Workbooks.Open(fd & f)
With .Sheets(1)
i = i + 1
ReDim Preserve Ar(2, s)
Ar(0, s) = "規格": Ar(1, s) = "數量"
s = s + 1
.UsedRange.Copy ThisWorkbook.Sheets(i).[A1]
With ThisWorkbook.Sheets(i)
For Each a In .Range(.[B2], .[B2].End(xlDown))
mystr = Mid(a, 1 / (i / 2))
If IsEmpty(d(mystr)) Then d(mystr) = a.Offset(, IIf(i = 1, 7, 2)) Else d(mystr) = a.Offset(, IIf(i = 1, 7, 2)) - d(mystr)
ReDim Preserve Ar(2, s)
Ar(0, s) = mystr: Ar(1, s) = a.Offset(, IIf(i = 1, 7, 2)).Value
s = s + 1
Next
Sheets(3).[A1].Offset(, (i - 1) * 2).Resize(s, 2) = Application.Transpose(Ar)
Erase Ar: s = 0
End With
End With
.Close 0
End With
Next
With Sheets(3)
.[E1].Resize(d.Count, 1) = Application.Transpose(d.keys)
.[F1].Resize(d.Count, 1) = Application.Transpose(d.items)
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

amychlo

中學生 Rank: 2

帖子: 9
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: Office 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-2-22
最後登錄: 2015-5-14

9^#

發表於 2013-3-18 20:49 | 只看該作者

回復 8# Hsieh

大大：感恩您！
大致上是可以了，
但是執行時發生
[執行階段錯誤'9'
陣列索引超出範圍]
再按(偵錯)後
就發現模組程式指向第24列，
所以不知道這一列是有什麼用途呢？
麻煩您囉！感恩

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 267
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-10-31

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

10^#

發表於 2013-3-18 23:06 | 只看該作者

回復 9# amychlo

這句是將陣列寫入工作表
此句會發生超出陣列索引錯誤只可能發生在Sheets(3)
有可能你的活頁簿並沒有3個以上的工作表存在

學海無涯_不恥下問

TOP

[發問] 比較資料-利用VBA程式比較兩個資料檔案並做計算

[發問] 比較資料-利用VBA程式比較兩個資料檔案並做計算

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]