帖子: 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

超級版主 Rank: 8 Rank: 8

帖子: 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
試試看

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

handsometrowa

中學生 Rank: 2

帖子: 82
主題: 7
精華: 0
積分: 112
點名: 0
作業系統: WIN7
軟體版本: WIN7
閱讀權限: 20
性別: 男
註冊時間: 2013-1-3
最後登錄: 2020-9-21

3^#

發表於 2013-7-25 11:17 | 只看該作者

回復 1# zv1122

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

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

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

複製代碼

TOP

zv1122

中學生 Rank: 2

帖子: 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)

迴圈方法的版面

上傳用.rar (17.73 KB)

我的檔案

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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
數值為何會跑掉
不要執行這行程式碼,看看複製後的公式

'.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

中學生 Rank: 2

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

6^#

發表於 2013-7-26 11:36 | 只看該作者

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

試過省略這行後

'.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

中學生 Rank: 2

帖子: 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)

手動更新時

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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的屬性

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

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

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]