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

sax868

Book11.zip (17.04 KB)

下載次數: 6

2012-5-23 16:43

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

複製代碼

下載 (169.54 KB)

2012-5-23 16:13

下載 (165.45 KB)

2012-5-23 16:13

各位大大午安：

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

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

弱女子留

register313

回復 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)

下載次數: 13

2012-5-23 21:15

sax868

回復 2# register313

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

感激不盡的
弱女子留

register313

回復 3# sax868

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

行號亦可改為行標籤

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

sax868

回復 4# register313

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