返回列表 上一主題 發帖

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

julianwic

帖子
9 
主題
2 
精華
0 
積分
17 
點名
0  
作業系統
WIN7 
軟體版本
2010 
閱讀權限
10 
性別
男 
來自
台中市 
註冊時間
2015-9-22 
最後登錄
2023-10-15 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-9-23 11:11 | 只看該作者

[發問] 使用 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

帖子
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

不知道對不對！
  1. Sub ex()
  2. Dim sh As Worksheet
  3. Dim Rng As Range, Rn As Range
  4. On Error Resume Next
  5. Set sh = Sheets("報價履歷")
  6. If sh Is Nothing Then '如果沒"報價履歷"工作表則新建一個
  7.     Set sh = Worksheets.Add
  8.     sh.Name = "報價履歷"
  9. End If
  10. With sh
  11.    
  12.     Sheets("GFF-ITO").Range("O3:P5").Copy .Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 2)
  13.     Set Rng = .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 2)
  14.     With Rng
  15.         Sheets("GFF-ITO").Range("b9:d9").Copy Rng
  16.         .HorizontalAlignment = xlCenter
  17.         .MergeCells = False
  18.         Sheets("GFF-ITO").Range("G9,J9,K9,L9").Copy .Offset(, 1)
  19.         Sheets("GFF-ITO").Range("V9").Copy .Offset(, 5)
  20.         Sheets("GFF-ITO").Range("O9,P9").Copy .Offset(, 6)
  21.         Sheets("GFF-ITO").Range("P9").Copy .Offset(, 8)
  22.         .Offset(, 8) = "價差"
  23.     End With

  25.     For Each Rn In Sheets("GFF-ITO").Range("D10:D60")
  26.         aa = Rn
  27.         If Rn = "###" Then Exit Sub
  28.         If Sheets("GFF-ITO").Cells(Rn.Row, "O") <> Sheets("GFF-ITO").Cells(Rn.Row, "P") Then
  29.             sro = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  30.             .Cells(sro, "A") = Rn.Value
  31.             .Cells(sro, "b") = Sheets("GFF-ITO").Cells(Rn.Row, "G")
  32.             .Cells(sro, "c") = Sheets("GFF-ITO").Cells(Rn.Row, "j")
  33.             .Cells(sro, "d") = Sheets("GFF-ITO").Cells(Rn.Row, "k")
  34.             .Cells(sro, "e") = Sheets("GFF-ITO").Cells(Rn.Row, "l")
  35.             .Cells(sro, "f") = Sheets("GFF-ITO").Cells(Rn.Row, "v")
  36.             .Cells(sro, "g") = Sheets("GFF-ITO").Cells(Rn.Row, "o")
  37.             .Cells(sro, "h") = Sheets("GFF-ITO").Cells(Rn.Row, "p")
  38.             .Cells(sro, "i") = .Cells(sro, "h") - .Cells(sro, "g")
  39.         End If
  40.     Next
  41. End With
  42. End Sub
複製代碼

TOP

julianwic

帖子
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

帖子
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
  1. Sub ex()
  2. Dim sh As Worksheet
  3. Dim Rng As Range, Rn As Range
  4. On Error Resume Next
  5. shn = Sheets(shn).Name
  6. Set sh = Sheets("報價履歷")
  7. If sh Is Nothing Then '如果沒"報價履歷"工作表則新建一個
  8.     Set sh = Worksheets.Add
  9.     sh.Name = "報價履歷"
  10. End If
  11. With sh
  12.    
  13.     Sheets(shn).Range("O3:P5").Copy .Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 2)
  14.     Set Rng = .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 2)
  15.     With Rng
  16.         Sheets(shn).Range("b9:d9").Copy Rng
  17.         .HorizontalAlignment = xlCenter
  18.         .MergeCells = False
  19.         Sheets(shn).Range("G9,J9,K9,L9").Copy .Offset(, 1)
  20.         Sheets(shn).Range("V9").Copy .Offset(, 5)
  21.         Sheets(shn).Range("O9,P9").Copy .Offset(, 6)
  22.         Sheets(shn).Range("P9").Copy .Offset(, 8)
  23.         .Offset(, 8) = "價差"
  24.     End With

  26.     For Each Rn In Sheets(shn).Range("D10:D60")
  27.         aa = Rn
  28.         If Rn = "###" Then Exit Sub
  29.         If Sheets(shn).Cells(Rn.Row, "O") <> Sheets(shn).Cells(Rn.Row, "P") Then
  30.             sro = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  31.             .Cells(sro, "A") = Rn.Value
  32.             .Cells(sro, "b") = Sheets(shn).Cells(Rn.Row, "G")
  33.             .Cells(sro, "c") = Sheets(shn).Cells(Rn.Row, "j")
  34.             .Cells(sro, "d") = Sheets(shn).Cells(Rn.Row, "k")
  35.             .Cells(sro, "e") = Sheets(shn).Cells(Rn.Row, "l")
  36.             .Cells(sro, "f") = Sheets(shn).Cells(Rn.Row, "v")
  37.             .Cells(sro, "g") = Sheets(shn).Cells(Rn.Row, "o")
  38.             .Cells(sro, "h") = Sheets(shn).Cells(Rn.Row, "p")
  39.             .Cells(sro, "i") = .Cells(sro, "h") - .Cells(sro, "g")
  40.         End If
  41.     Next
  42. End With
  43. End Sub
複製代碼

TOP

julianwic

帖子
9 
主題
2 
精華
0 
積分
17 
點名
0  
作業系統
WIN7 
軟體版本
2010 
閱讀權限
10 
性別
男 
來自
台中市 
註冊時間
2015-9-22 
最後登錄
2023-10-15 
5#
發表於 2015-9-24 11:30 | 只看該作者
IPK187 大大，測試後，程式執行到第 27 行 (If Rn = "###" Then Exit Sub) 這個判斷式後就會直接跳到 End sub，不曉得是什麼問題，可以麻煩再看一下嗎？謝謝您

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2015-9-24 13:23 | 只看該作者
回復 5# julianwic


    shn = Sheets(shn).Name
這句改成
shn = ActiveSheet.Name

TOP

julianwic

帖子
9 
主題
2 
精華
0 
積分
17 
點名
0  
作業系統
WIN7 
軟體版本
2010 
閱讀權限
10 
性別
男 
來自
台中市 
註冊時間
2015-9-22 
最後登錄
2023-10-15 
7#
發表於 2015-9-24 13:33 | 只看該作者
修改後程式 OK 了，謝謝 lpk187 大大的協助！

TOP

        靜思自在 : 君子立恆志，小人恆立志。
返回列表 上一主題