[發問] 怎樣用VBA將分頁內的不同列資料更新後，自動填入到不同分頁的某一列？

leondavinci727

請問能做到當我資料頁更新資料後，所指定的列資料就寫入個別分頁，且從上一筆被紀錄的資料依序往下記錄下去嗎？
懇請賜教，謝謝~

Test.zip (53.14 KB)

範例
下載次數: 12

2013-3-27 09:52

Hsieh

回復 1# leondavinci727

1. Sub activateMacro()
   
2. Dim dic As Object, ky, A As Range, r%
   
3. Set dic = CreateObject("Scripting.Dictionary")
   
4.     Dim com_no As String
   
5.         com_no = Worksheets("類D").Range("$K$3").Value
   
6. With ActiveSheet.QueryTables("類D")
   
7. .Connection = "URL;http://www.twse.com.tw/ch/trading/exchange/BFIAMU/genpage/Report201303/" & com_no & "_F3_1_5.php?chk_date=102/03/26"
   
8. .FieldNames = True
   
9. .RowNumbers = False
   
10. .FillAdjacentFormulas = False
    
11. .PreserveFormatting = True
    
12. .RefreshOnFileOpen = False
    
13. .BackgroundQuery = True
    
14. .RefreshStyle = xlOverwriteCells
    
15. .SavePassword = False
    
16. .SaveData = True
    
17. .AdjustColumnWidth = False
    
18. .RefreshPeriod = 0
    
19. .WebFormatting = xlWebFormattingNone
    
20. .WebTables = "8"
    
21. .WebPreFormattedTextToColumns = True
    
22. .WebConsecutiveDelimitersAsOne = True
    
23. .WebSingleBlockTextImport = False
    
24. .WebDisableDateRecognition = False
    
25. .WebDisableRedirections = False
    
26. .Refresh BackgroundQuery:=False
    
27. End With
    
28. r = 35
    
29. Do Until Cells(r, 1) = ""
    
30. dic(Cells(r, 1).Value) = Range(Cells(r + 1, 1), Cells(r + 1, 1).End(xlToRight)).Value
    
31. r = r + 2
    
32. Loop
    
33. For Each ky In dic.keys
    
34.    With Sheets(ky)
    
35.    Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
    
36.    A.Resize(, UBound(dic(ky), 2)) = dic(ky)
    
37.    End With
    
38. Next
    
39. End Sub

複製代碼

leondavinci727

回復 2# Hsieh
:D  非常感謝 Hsieh 超級版主的幫忙！ 執行完全無誤，謝謝您那麼快速的伸出援手，小弟有很多看不懂的地方要在好好研究，非常感謝~