篩選資料並且放到新的Sheet裡 - Excel程式區

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兔年全勤獎章

13^# 跳轉到 »

發表於 2011-3-23 18:48 | 只看該作者

回復 13# candy516
你1樓的訴求不是這樣?
還有其他想法說說看

TOP

candy516

中學生 Rank: 2

帖子: 47
主題: 5
精華: 0
積分: 116
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 女
註冊時間: 2011-1-14
最後登錄: 2012-3-10

12^#

發表於 2011-3-23 18:42 | 只看該作者

回復 11# GBKEE

成功了!
前輩您所寫的程式是不是只能單獨選一支股票?

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兔年全勤獎章

11^#

發表於 2011-3-23 18:33 | 只看該作者

回復 9# candy516
股票代號: 有誤
表示在Sheets("Sheet1") 沒有用滑鼠選定股票代號
你的檔案Sheets("Sheet1")是選在 A1 "證券代碼"
請在Sheets("Sheet1")的A欄選定一家的證券代碼再試試

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 142
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2026-7-16

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

10^#

發表於 2011-3-23 18:22 | 只看該作者

回復 8# candy516

x = Application.Max(3, C.Row - 14)
是因為要算找到日期的位置往上14格的列號
若往上14格的列號只有<=3就要以3作為開始抓資料的列位
所以若你要抓30天資料這邊也要改
x = Application.Max(3, C.Row - 29)

學海無涯_不恥下問

TOP

candy516

中學生 Rank: 2

帖子: 47
主題: 5
精華: 0
積分: 116
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 女
註冊時間: 2011-1-14
最後登錄: 2012-3-10

9^#

發表於 2011-3-23 18:20 | 只看該作者

回復 7# GBKEE

謝謝前輩!^^

報酬率(test).rar (309.77 KB)

TOP

candy516

中學生 Rank: 2

帖子: 47
主題: 5
精華: 0
積分: 116
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 女
註冊時間: 2011-1-14
最後登錄: 2012-3-10

8^#

發表於 2011-3-23 18:17 | 只看該作者

回復 6# Hsieh

  請問Hsieh 前輩~
這兩次的程式碼差別最主要是"x = Application.Max(3, C.Row - 14)"嗎?代表意思是?!
如果我要改抓除息日後30日的報酬是不是將部分程式碼改掉即可?!
If Not C Is Nothing And Not B Is Nothing Then
x = Application.Max(3, C.Row - 14)
Set B1 = .[A1:A2]
Set B2 = B.Resize(2, 1)
Set Rng = .Cells(x, 1).Resize(30, 1)
Set Rng1 = .Cells(x, B.Column).Resize(30, 1)
With sht
   B1.Copy .Cells(r, k)
   B2.Copy .Cells(r, k + 1)
   Rng.Copy .Cells(r + 2, k)
   Rng1.Copy .Cells(r + 2, k + 1)
End With
k = IIf(k = 255, 1, k + 2)
r = IIf(k = 1, r + 33, r)
Else
MsgBox "無此除權資料"

謝謝您!

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兔年全勤獎章

7^#

發表於 2011-3-23 17:43 | 只看該作者

回復 3# candy516
傳檔來看看

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 142
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2026-7-16

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2011-3-23 17:39 | 只看該作者

回復 5# candy516
日期順序看錯，要往上15天才對
順便將無資料條件改一下

Sub ex()
Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
Set d = CreateObject("Scripting.Dictionary")
Set sht = Sheets.Add(after:=Sheets(1))
Application.ScreenUpdating = False
With Sheet1
For Each A In .Range(.[A2], .[A65536].End(xlUp))
mystr = A & "," & Left(A.Offset(, 1), 4)
d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
Next
End With
k = 1: r = 1
For Each ky In d.keys
y = Split(ky, ",")(1)
With Sheets(y)
Set C = .Columns("A").Find(d(ky))
Set B = .Rows(1).Find(Split(ky, ",")(0))
If Not C Is Nothing And Not B Is Nothing Then
x = Application.Max(3, C.Row - 14)
Set B1 = .[A1:A2]
Set B2 = B.Resize(2, 1)
Set Rng = .Cells(x, 1).Resize(15, 1)
Set Rng1 = .Cells(x, B.Column).Resize(15, 1)
With sht
B1.Copy .Cells(r, k)
B2.Copy .Cells(r, k + 1)
Rng.Copy .Cells(r + 2, k)
Rng1.Copy .Cells(r + 2, k + 1)
End With
k = IIf(k = 255, 1, k + 2)
r = IIf(k = 1, r + 18, r)
Else
MsgBox "無此除權資料"
End If
End With
Next
Application.ScreenUpdating = True
End Sub

複製代碼

學海無涯_不恥下問

TOP

candy516

中學生 Rank: 2

帖子: 47
主題: 5
精華: 0
積分: 116
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 女
註冊時間: 2011-1-14
最後登錄: 2012-3-10

5^#

發表於 2011-3-23 17:15 | 只看該作者

回復 4# Hsieh

謝謝Hsieh 前輩!
再跑出來的結果裡，第一筆資料是黑松是20100719~20100629，但我想要的結果是20100719~20100806~
請問我這樣需要改哪一個地方?我有試著更改，但無法跑出來。另外在請教一下，如果我接下的資料更改，像是把報酬率換成每股盈餘，
而我同樣是要用程式抓出除息日後14天得資料，是否把程式碼貼上即可!(資料格式一樣)
感謝您的幫忙!

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 142
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2026-7-16

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2011-3-23 16:50 | 只看該作者

本帖最後由 Hsieh 於 2011-3-23 16:56 編輯

回復 3# candy516

Sub ex()
Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
Set d = CreateObject("Scripting.Dictionary")
Set sht = Sheets.Add(after:=Sheets(1))
Application.ScreenUpdating = False
With Sheet1
For Each A In .Range(.[A2], .[A65536].End(xlUp))
mystr = A & "," & Left(A.Offset(, 1), 4)
d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
Next
End With
k = 1: r = 1
For Each ky In d.keys
y = Split(ky, ",")(1)
With Sheets(y)
Set C = .Columns("A").Find(d(ky))
If Not C Is Nothing Then
Set B = .Rows(1).Find(Split(ky, ",")(0))
Set B1 = .[A1:A2]
Set B2 = B.Resize(2, 1)
Set Rng = C.Resize(15, 1)
Set Rng1 = .Cells(C.Row, B.Column).Resize(15, 1)
With sht
B1.Copy .Cells(r, k)
B2.Copy .Cells(r, k + 1)
Rng.Copy .Cells(r + 2, k)
Rng1.Copy .Cells(r + 2, k + 1)
End With
k = IIf(k = 255, 1, k + 2)
r = IIf(k = 1, r + 18, r)
Else
MsgBox "無此除權資料"
End If
End With
Next
Application.ScreenUpdating = True
End Sub

複製代碼

學海無涯_不恥下問

TOP

[發問] 篩選資料並且放到新的Sheet裡

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

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