返回列表 上一主題 發帖

[發問] 請問如何撰寫VBA，使有值的欄位複製到特定工作表且新的資料覆寫(已解決)

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-5-23 16:48 | 只看該作者

[發問] 請問如何撰寫VBA，使有值的欄位複製到特定工作表且新的資料覆寫(已解決)

本帖最後由 sax868 於 2012-5-24 10:28 編輯

Book11.zip (17.04 KB)
  1. Sub Macro6()
  2. '
  3. '
  4.     Sheets("Updated Data").Select
  5.     Range("BC2").Select
  6.     ActiveCell.FormulaR1C1 = "=IF(RC[-13]=RC[-1],1,0)"
  7.     Range("BC2").Select
  8.     Selection.Copy
  9.     Range("BC3").Select
  10.     Range(Selection, Selection.End(xlDown)).Select
  11.     ActiveSheet.Paste
  12.     Cells.Select
  13.     Application.CutCopyMode = False
  14.     Selection.AutoFilter
  15.     ActiveSheet.Range("$A$1:$BC$491").AutoFilter Field:=55, Criteria1:="0"
  16.     ActiveWindow.SmallScroll Down:=-6
  17.     Range("A6:BB9").Select
  18.     Selection.Copy
  19.     Sheets("Notes").Select
  20.     ActiveWindow.SmallScroll Down:=-3
  21.     Range("A2").Select
  22.     ActiveSheet.Paste
  23.     Columns("BC:BC").Select
  24.     Application.CutCopyMode = False
  25.     Selection.ClearContents
  26.     Sheets("Updated Data").Select
  27.     Columns("BC:BC").Select
  28.     Selection.ClearContents
  29.     ActiveSheet.ShowAllData
  30.     Selection.AutoFilter
  31.     Range("A1").Select
  32.     ActiveWorkbook.Save
  33. End Sub
複製代碼
各位大大午安：

請問如何撰寫VBA，將有Updated Data工作表裡AP欄及BB欄有值的整行複製並存到Notes工作表裡？又Notes工作表有如資料庫般, 倘若Updated Data裡的資料Notes遇到重複的，則會以新的資料為主，即將有AP欄及BB欄有值的整行複製儲存到Notes工作表裡並覆寫蓋過去。
目前我只能手動先用=IF(AP2=BB2,1,0) 選出都是空格的不要後，複製、貼上到Notes工作表，如果有重複的再自己手動刪。

麻煩請大大們救救我~~~
感激不盡!

弱女子留
收藏 分享

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
2#
發表於 2012-5-23 21:15 | 只看該作者
回復 1# sax868
  1. Sub XX()
  2. With Sheets("Updated Data")
  3.   For R1 = 2 To .[A65536].End(xlUp).Row
  4.     If .Cells(R1, "AP") & .Cells(R1, "BB") <> "" Then
  5.       For R2 = 2 To Sheets("Notes").[A65536].End(xlUp).Row
  6.         If .Cells(R1, "A") & .Cells(R1, "C") & .Cells(R1, "E") = Sheets("Notes").Cells(R2, "A") & Sheets("Notes").Cells(R2, "C") & Sheets("Notes").Cells(R2, "E") Then
  7.           .Rows(R1).Copy Sheets("Notes").Rows(R2)
  8.           GoTo 10
  9.         End If
  10.       Next R2
  11.       .Rows(R1).Copy Sheets("Notes").[A65536].End(xlUp).Offset(1, 0)
  12. 10
  13.     End If
  14.   Next R1
  15. End With
  16. End Sub
複製代碼
1.rar (9.63 KB)

TOP

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
3#
發表於 2012-5-24 09:44 | 只看該作者
回復 2# register313

非常感激高手register313 大大的幫忙!很好用喔!這下我的人生又從黑白變回彩色的了!!
另外，想請教文中的 "10"代表甚麼意思呢?

感激不盡的
弱女子留

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
4#
發表於 2012-5-24 12:14 | 只看該作者
回復 3# sax868

    GoTo 10       '跳至行號10
   
    10               '行號10

行號亦可改為行標籤

   GoTo abc     '跳至行標籤abc
   
     abc:            '行標籤abc

TOP

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
5#
發表於 2012-5-24 15:28 | 只看該作者
回復 4# register313

了解!真受用~謝謝R大指教!!

TOP

        靜思自在 : 難行能行，難捨能捨，難為能為，才能昇華自我的人格。
返回列表 上一主題