Board logo

標題: [發問] 使用 VBA 比對兩個欄位的內容是否相同 [打印本頁]
作者: julianwic    時間: 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 個動作。

[attach]22058[/attach]
作者: lpk187    時間: 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
複製代碼
作者: julianwic    時間: 2015-9-24 10:33

IPK187 大大，真是太感謝您了，剛才測試了一下執行上是沒有問題的，但有個地方想請你再幫忙修改一下，因為執行的活頁名稱不會都固定為【GFF-ITO】，可否修改成擷取按下巨集時的活頁簿名稱來使用，謝謝。
作者: lpk187    時間: 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
複製代碼
作者: julianwic    時間: 2015-9-24 11:30

IPK187 大大，測試後，程式執行到第 27 行 (If Rn = "###" Then Exit Sub) 這個判斷式後就會直接跳到 End sub，不曉得是什麼問題，可以麻煩再看一下嗎？謝謝您
作者: lpk187    時間: 2015-9-24 13:23

回復 5# julianwic


    shn = Sheets(shn).Name
這句改成
shn = ActiveSheet.Name
作者: julianwic    時間: 2015-9-24 13:33

修改後程式 OK 了，謝謝 lpk187 大大的協助！



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)