返回列表 上一主題 發帖

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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 2015-9-24 13:23 | 顯示全部帖子
回復 5# julianwic


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

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。
返回列表 上一主題