返回列表 上一主題 發帖

[發問] 錄製巨集每日向下新增一列資料-選擇性貼上設定

zv1122

帖子
6 
主題
2 
精華
0 
積分
58 
點名
0  
作業系統
WIN7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2013-5-13 
最後登錄
2016-7-24 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

handsometrowa

帖子
82 
主題
7 
精華
0 
積分
112 
點名
0  
作業系統
WIN7 
軟體版本
WIN7 
閱讀權限
20 
性別
男 
註冊時間
2013-1-3 
最後登錄
2020-9-21 
3#
發表於 2013-7-25 11:17 | 只看該作者
回復 1# zv1122


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

但是你貼上的程式碼 可以利用以下這段
  1. Sub CopyPaste()

  3. Sheets("sheet1").Range("A1:E1").Copy
  4. '我幫你改成A1:E1五欄，需要的你再自己改
  5. With Sheets("sheet2")

  7. .Activate                    
  8. .Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues  

  10. '使用PasteSpecial 方法，可以類似你複製一段範圍，到你要的地方按右鍵，選擇性貼上裡面的所有功能，裡面好樣沒包含你的管理規則，就是依據規則上色的部分(這部分我不知道有沒有搞懂，你上色是直接貼上顏色還是，依據管理規則變色??)，所以使用xlPasteValues  只貼上值


  13.     'Sheets("A")的C欄最後一列(Cells(Rows.Count, "C"),
  14.     'End(xlUp)往上到有資料列
  15.     'Offset(1)的下一列
  16. End With


  19. End Sub
複製代碼

TOP

zv1122

帖子
6 
主題
2 
精華
0 
積分
58 
點名
0  
作業系統
WIN7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2013-5-13 
最後登錄
2016-7-24 
4#
發表於 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

上傳用2.png (24.87 KB)

迴圈方法的版面

上傳用2.png

上傳用.rar (17.73 KB)

我的檔案

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 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
上傳的檔案 你要有如圖片上的架構,才好幫你的.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

zv1122

帖子
6 
主題
2 
精華
0 
積分
58 
點名
0  
作業系統
WIN7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2013-5-13 
最後登錄
2016-7-24 
6#
發表於 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

TOP

zv1122

帖子
6 
主題
2 
精華
0 
積分
58 
點名
0  
作業系統
WIN7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2013-5-13 
最後登錄
2016-7-24 
7#
發表於 2013-7-26 11:56 | 只看該作者
本帖最後由 zv1122 於 2013-7-26 12:10 編輯

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

上傳.png (61.6 KB)

手動更新時

上傳.png

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
返回列表 上一主題