標題: [發問] 錄製巨集每日向下新增一列資料-選擇性貼上設定 [打印本頁]

---

作者: zv1122    時間: 2013-7-25 09:40     標題: 錄製巨集每日向下新增一列資料-選擇性貼上設定

http://forum.twbts.com/redirect. ... amp;goto=nextnewset
我參考這一篇的巨集後寫成我所需要的巨集，但是現在遇到無法選擇性貼上"值"，我的巨集會把公式也給抓過去。
如果可以的話我希望能改成貼上-值與原始格式設定(因為有時候我會把儲存格上色 )


Sub 抓資料到儲存格()
    Sheets("A").Range("C1:T1").Copy Sheets("A").Cells(Rows.Count, "C").End(xlUp).Offset(1)
    'Sheets("A")的C欄最後一列(Cells(Rows.Count, "C"),
    'End(xlUp)往上到有資料列
    'Offset(1)的下一列
End Sub

---

作者: GBKEE    時間: 2013-7-25 10:58

本帖最後由 GBKEE 於 2013-7-25 11:02 編輯

回復 1# zv1122
試試看

1. Option Explicit
   
2. Sub 抓資料到儲存格()
   
3.       Dim R As Integer, Col As Integer
   
4.       With Sheets("A")
   
5.          R = .Cells(Rows.Count, "C").End(xlUp).Offset(1).Row             'R =>最後一的列號 ' Row:物件的屬性 傳回Cells的列號
   
6.          Col = .Range("C1:T1").Columns.Count                             'Col => Copy範圍的總欗數
   
7.         'Columns:儲存格的物件(欄)
   
8.         'Count : 物件的屬性,傳回物件的數量
   
9.         .Range("C1:T1").Copy .Cells(R, "C")
   
10.         .Cells(R, "C").Resize(1, Col) = .Cells(R, "C").Resize(1, Col).Value
    
11.         '***** Value: 物件的屬性,傳回公式計算後的值           *************
    
12.     End With
    
13. End Sub

複製代碼

---

作者: handsometrowa    時間: 2013-7-25 11:17

回復 1# zv1122


   因為你上色的部分，在2007牽扯到管理規則我真的不知道怎麼幫你解決

但是你貼上的程式碼 可以利用以下這段

1. Sub CopyPaste()
   
2. 
   
3. Sheets("sheet1").Range("A1:E1").Copy
   
4. '我幫你改成A1:E1五欄，需要的你再自己改
   
5. With Sheets("sheet2")
   
6. 
   
7. .Activate                    
   
8. .Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues  
   
9. 
   
10. '使用PasteSpecial 方法，可以類似你複製一段範圍，到你要的地方按右鍵，選擇性貼上裡面的所有功能，裡面好樣沒包含你的管理規則，就是依據規則上色的部分(這部分我不知道有沒有搞懂，你上色是直接貼上顏色還是，依據管理規則變色??)，所以使用xlPasteValues  只貼上值
    
11. 
    
12. 
    
13.     'Sheets("A")的C欄最後一列(Cells(Rows.Count, "C"),
    
14.     'End(xlUp)往上到有資料列
    
15.     'Offset(1)的下一列
    
16. End With
    
17. 
    
18. 
    
19. End Sub

複製代碼

---

作者: zv1122    時間: 2013-7-25 15:19

本帖最後由 zv1122 於 2013-7-25 15:30 編輯

回復 2# GBKEE
試過之後
GBKEE大的方法可以抓到顏色，但是抓到的值好像位置跑掉，值變成0。
handsometrowa 大的方法可以抓到值可是上不了顏色 。
    先前可能沒解釋清楚，我補上我的檔案。我以前都是手動貼上後，從貼上選項方塊選擇"值與原始格式設定"。
    我在想問題是不是不能用COPY要用=才可以把值和顏色都正確抓到。


    以前在網路上有人分享過類似檔案是用迴圈程式碼抓資料，他的方法我似懂非懂，所以想問各位有沒有其他方法解決。---圖片檔是這個迴圈的大致版面。
Dim DealerOpNetVol, DealerOpNetVal, DealerOpToTXF, DealerTXFNetVol, DealerTXFOPNetVol  As Double
Dim FiniOpNetVol, FiniOpNetVal, FiniOpToTXF, FiniTXFNetVol, FiniTXFOPNetVol  As Double
Dim LastDay As String
Dim TwClose, TwChange, TwVolume As Double


Private Sub CommandButton1_Click()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''  抓自營商(Dealer)及外資(Fini)期貨大台(TXF)及選擇權(options) '''''''''''''''''''''''''''''''''''''
    Sheets("期貨選擇權多空統計").Select
   
    ''自營商(Dealer)''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''抓自營商(Dealer)選擇權淨口數 Dealer Options Net Volume '''''''''''''''''''''''''''''''''''''''''
    DealerOpNetVol = Sheets("期貨選擇權多空統計").Range("B4")
   
    ''''''抓自營商(Dealer)選擇權淨金額(億) Dealer Options Net Value'''''''''''''''''''''''''''''''''''''''
    DealerOpNetVal = Sheets("期貨選擇權多空統計").Range("C4")
        
    ''''''抓自營商(Dealer)選擇權約當大台 Dealer Options transfer to TXF'''''''''''''''''''''''''''''''''''
    DealerOpToTXF = Sheets("期貨選擇權多空統計").Range("D4")
   
    ''''''抓自營商(Dealer)大台淨口數 Dealer TXF Net Volume''''''''''''''''''''''''''''''''''''''''''''''''
    DealerTXFNetVol = Sheets("期貨選擇權多空統計").Range("E4")
   
    '''''''抓自營商(Dealer)期權淨口數 Dealer TXF Options Net Volume'''''''''''''''''''''''''''''''''''''''
    DealerTXFOPNetVol = Sheets("期貨選擇權多空統計").Range("F4")
   
    ''外資(Fini)''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''抓外資(Fini)選擇權淨口數 Fini Options Net Volume '''''''''''''''''''''''''''''''''''''''''''''''
    FiniOpNetVol = Sheets("期貨選擇權多空統計").Range("G4")
   
    ''''''抓外資(Fini)選擇權淨金額(億) Fini Options Net Value'''''''''''''''''''''''''''''''''''''''''''''
    FiniOpNetVal = Sheets("期貨選擇權多空統計").Range("H4")
        
    ''''''抓外資(Fini)選擇權約當大台 Fini Options transfer to TXF'''''''''''''''''''''''''''''''''''''''''
    FiniOpToTXF = Sheets("期貨選擇權多空統計").Range("I4")
   
    ''''''抓外資(Fini)大台淨口數 Fini TXF Net Volume''''''''''''''''''''''''''''''''''''''''''''''''''''''
    FiniTXFNetVol = Sheets("期貨選擇權多空統計").Range("J4")
   
    '''''''抓外資(Fini)期權淨口數 Fini TXF Options Net Volume'''''''''''''''''''''''''''''''''''''''''''''
    FiniTXFOPNetVol = Sheets("期貨選擇權多空統計").Range("K4")
   
    '''''''抓大盤指數 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    TwClose = Sheets("期貨選擇權多空統計").Range("L4")
   
    '''''''抓大盤漲跌 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    TwChange = Sheets("期貨選擇權多空統計").Range("M4")
   
   
    '''''''抓大盤成交量 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    TwVolume = Sheets("期貨選擇權多空統計").Range("N4")
   
    ''''''''''''''''抓今天日期 get last day value''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("選擇權買賣權分計").Select
    Sheets("選擇權買賣權分計").Range("A1") = Mid(Sheets("選擇權買賣權分計").Range("C14"), 4, 10)
    LastDay = Sheets("期貨選擇權多空統計").Range("A4").Text
   
    '''''''''''''''''將抓取的數值自動填入期貨選擇權多空統計表''''''''''''''''''''''''''''''''''''''''''''''
   
    Sheets("期貨選擇權多空統計").Select
    I = 8
    Do
       I = I + 1
       If I > 1000 Then
          Exit Do
       End If
    Loop Until (LastDay = Sheets("期貨選擇權多空統計").Cells(I, 1).Text)

    Sheets("期貨選擇權多空統計").Cells(I, "B") = DealerOpNetVol
    Sheets("期貨選擇權多空統計").Cells(I, "C") = DealerOpNetVal
    Sheets("期貨選擇權多空統計").Cells(I, "D") = DealerOpToTXF
    Sheets("期貨選擇權多空統計").Cells(I, "E") = DealerTXFNetVol
    Sheets("期貨選擇權多空統計").Cells(I, "F") = DealerTXFOPNetVol
    Sheets("期貨選擇權多空統計").Cells(I, "G") = FiniOpNetVol
    Sheets("期貨選擇權多空統計").Cells(I, "H") = FiniOpNetVal
    Sheets("期貨選擇權多空統計").Cells(I, "I") = FiniOpToTXF
    Sheets("期貨選擇權多空統計").Cells(I, "J") = FiniTXFNetVol
    Sheets("期貨選擇權多空統計").Cells(I, "K") = FiniTXFOPNetVol
   
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''大盤指數
    Sheets("期貨選擇權多空統計").Cells(I, "L") = TwClose
    Sheets("期貨選擇權多空統計").Cells(I, "M") = TwChange
    Sheets("期貨選擇權多空統計").Cells(I, "N") = TwVolume
   
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

---

作者: GBKEE    時間: 2013-7-25 16:48

回復 4# zv1122
數值為何會跑掉  
不要執行這行程式碼,看看複製後的公式

1. '.Cells(R, "C").Resize(1, Col) = .Cells(R, "C").Resize(1, Col).Value

複製代碼

C1的公式(相對的參照)  =B!D20/100, 如複製到C11公式變成=B!D30/100
($ 絕對的參照) =B!$D$20/100       , 如複製到C11 公式還是=B!$D$20/100
上傳的檔案 你要有如圖片上的架構,才好幫你的.

---

作者: zv1122    時間: 2013-7-26 11:36

回復 5# GBKEE
原來是我基本出問題忘記設定絕對位置，儲存格改成絕對；上色-設定格式化的條件改成相對後完全是我想要的巨集，一開始的回覆就是正確解答。  

試過省略這行後

1. '.Cells(R, "C").Resize(1, Col) = .Cells(R, "C").Resize(1, Col).Value

複製代碼

會變成把公式一起抓過去，每天一更新，儲存格紀錄的資料反而被洗掉。
問題已解決，感謝

補問一下關於”copy”和”=”的差別是不是copy會把公式一起抓過去；=則是記錄值。  在我後來附圖的excel更新作法是透過迴圈比對日期相符的列後用=來抓值，用儲存格=定義的double。
而在下面這篇的方法中我執行巨集會抓到公式，原因是不是copy會抓到公式?
http://forum.twbts.com/redirect. ... amp;goto=nextnewset

---

作者: zv1122    時間: 2013-7-26 11:56

本帖最後由 zv1122 於 2013-7-26 12:10 編輯

回復 3# handsometrowa
我上色的部分是利用格式-設定格式化的條件來判斷上色。
以往我手動更新都是複製後到C欄第N列CTRL+V在點選附圖的貼上選項選擇”值與原始格式設定(U)”的選項
問題已解決，感謝回覆。

---

作者: GBKEE    時間: 2013-7-26 12:04

回復 6# zv1122
  物件A的屬性=物件B的屬性

1. Option Explicit
   
2. Sub 抓資料到儲存格()
   
3.       Dim R As Integer, Rng As Range
   
4.       With Sheets(1)
   
5.          R = .Cells(Rows.Count, "C").End(xlUp).Offset(1).Row
   
6.          Set Rng = .Range("C1:T1")         ' 物件B
   
7.         .Range("C" & R & ":T" & R) = Rng.Value                     '物件A的屬性=物件B的屬性
   
8.         .Range("C" & R & ":T" & R).Interior.ColorIndex = Rng.Interior.ColorIndex  '物件A的屬性=物件B的屬性
   
9.     End With
   
10. End Sub

複製代碼

---

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