[發問] 使用 VBA 比對兩個欄位的內容是否相同

各位大大，因我剛接觸 VBA 不久，但又急需寫個小程式來應付日常工作，故想請各位大大幫忙，不勝感激 :D ，底下是程式所需的內容描述，資料檔案如附件內容。

1、判斷【報價履歷】的活頁名稱是否存在，若不存在則建立一個，若存在則跳至該活頁。
2、複製【GFF-ITO】活頁內的 O3 ~ P5 的內容。
3、選擇【報價履歷】活頁，移動至 A 欄資料的最尾端，並再往下移動兩列。
4、將 O3 ~ P5 的內容貼上。
5、往下移動一列。
6、複製【GFF-ITO】活頁內的欄位名稱過來，A欄 ='GFF-ITO'!B9，B欄='GFF-ITO'!G9，C欄='GFF-ITO'!J9…..等，並在 I欄填入價差。
7、移動到 D10，判斷內容是否為 ###，若是則結束程式。
8、比對【GFF-ITO】活頁 O10 跟 P10 兩個欄位的內容，若內容不相等，則將 B、G、J、K、L、V、O、P 欄的資料複製到【報價履歷】活頁內的相對位置，若相等則再往下判斷 D11 是否為 ###，若是則結束程式，若否則繼續執行第 8 個動作。

報價履歷測試檔-0923.zip (761.54 KB)

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

2^#

發表於 2015-9-23 19:26 | 只看該作者

回復 1# julianwic

不知道對不對！

Sub ex()
Dim sh As Worksheet
Dim Rng As Range, Rn As Range
On Error Resume Next
Set sh = Sheets("報價履歷")
If sh Is Nothing Then '如果沒"報價履歷"工作表則新建一個
Set sh = Worksheets.Add
sh.Name = "報價履歷"
End If
With sh
Sheets("GFF-ITO").Range("O3:P5").Copy .Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 2)
Set Rng = .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 2)
With Rng
Sheets("GFF-ITO").Range("b9:d9").Copy Rng
.HorizontalAlignment = xlCenter
.MergeCells = False
Sheets("GFF-ITO").Range("G9,J9,K9,L9").Copy .Offset(, 1)
Sheets("GFF-ITO").Range("V9").Copy .Offset(, 5)
Sheets("GFF-ITO").Range("O9,P9").Copy .Offset(, 6)
Sheets("GFF-ITO").Range("P9").Copy .Offset(, 8)
.Offset(, 8) = "價差"
End With
For Each Rn In Sheets("GFF-ITO").Range("D10:D60")
aa = Rn
If Rn = "###" Then Exit Sub
If Sheets("GFF-ITO").Cells(Rn.Row, "O") <> Sheets("GFF-ITO").Cells(Rn.Row, "P") Then
sro = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(sro, "A") = Rn.Value
.Cells(sro, "b") = Sheets("GFF-ITO").Cells(Rn.Row, "G")
.Cells(sro, "c") = Sheets("GFF-ITO").Cells(Rn.Row, "j")
.Cells(sro, "d") = Sheets("GFF-ITO").Cells(Rn.Row, "k")
.Cells(sro, "e") = Sheets("GFF-ITO").Cells(Rn.Row, "l")
.Cells(sro, "f") = Sheets("GFF-ITO").Cells(Rn.Row, "v")
.Cells(sro, "g") = Sheets("GFF-ITO").Cells(Rn.Row, "o")
.Cells(sro, "h") = Sheets("GFF-ITO").Cells(Rn.Row, "p")
.Cells(sro, "i") = .Cells(sro, "h") - .Cells(sro, "g")
End If
Next
End With
End Sub

複製代碼

TOP

julianwic

小學生 Rank: 1

帖子: 9
主題: 2
精華: 0
積分: 17
點名: 0
作業系統: WIN7
軟體版本: 2010
閱讀權限: 10
性別: 男
來自: 台中市
註冊時間: 2015-9-22
最後登錄: 2023-10-15

3^#

發表於 2015-9-24 10:33 | 只看該作者

IPK187 大大，真是太感謝您了，剛才測試了一下執行上是沒有問題的，但有個地方想請你再幫忙修改一下，因為執行的活頁名稱不會都固定為【GFF-ITO】，可否修改成擷取按下巨集時的活頁簿名稱來使用，謝謝。

TOP

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

4^#

發表於 2015-9-24 11:02 | 只看該作者

回復 3# julianwic

Sub ex()
Dim sh As Worksheet
Dim Rng As Range, Rn As Range
On Error Resume Next
shn = Sheets(shn).Name
Set sh = Sheets("報價履歷")
If sh Is Nothing Then '如果沒"報價履歷"工作表則新建一個
Set sh = Worksheets.Add
sh.Name = "報價履歷"
End If
With sh
Sheets(shn).Range("O3:P5").Copy .Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 2)
Set Rng = .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 2)
With Rng
Sheets(shn).Range("b9:d9").Copy Rng
.HorizontalAlignment = xlCenter
.MergeCells = False
Sheets(shn).Range("G9,J9,K9,L9").Copy .Offset(, 1)
Sheets(shn).Range("V9").Copy .Offset(, 5)
Sheets(shn).Range("O9,P9").Copy .Offset(, 6)
Sheets(shn).Range("P9").Copy .Offset(, 8)
.Offset(, 8) = "價差"
End With
For Each Rn In Sheets(shn).Range("D10:D60")
aa = Rn
If Rn = "###" Then Exit Sub
If Sheets(shn).Cells(Rn.Row, "O") <> Sheets(shn).Cells(Rn.Row, "P") Then
sro = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(sro, "A") = Rn.Value
.Cells(sro, "b") = Sheets(shn).Cells(Rn.Row, "G")
.Cells(sro, "c") = Sheets(shn).Cells(Rn.Row, "j")
.Cells(sro, "d") = Sheets(shn).Cells(Rn.Row, "k")
.Cells(sro, "e") = Sheets(shn).Cells(Rn.Row, "l")
.Cells(sro, "f") = Sheets(shn).Cells(Rn.Row, "v")
.Cells(sro, "g") = Sheets(shn).Cells(Rn.Row, "o")
.Cells(sro, "h") = Sheets(shn).Cells(Rn.Row, "p")
.Cells(sro, "i") = .Cells(sro, "h") - .Cells(sro, "g")
End If
Next
End With
End Sub