[發問] 原有工作表中不同欄位資料，轉移到新產生工作表中，並重新安排位置(已解決)

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

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

2^#

發表於 2011-4-4 09:58 | 只看該作者

回復 1# jesscc

Sub SourceData_S()
Dim Ay()
With Worksheets("資料來源")
Set Rng = .Range("A3:B3")
fs = False
If .Range("B3").Value = "" Then
MsgBox "無法取得股票名稱,請確定股票名稱已填入B3儲存格", 32, "資料錯誤!"
Exit Sub
End If
For Each sh In Sheets
If sh.Name = .[B3].Text Then fs = True: Exit For
Next
If fs = False Then Sheets.Add.Name = .[B3].Text
ar = Array("A", "C", "I", "P")
ReDim Preserve Ay(s)
Ay(s) = Array(.Cells(4, ar(0)).Value, .Cells(4, ar(1)).Value, .Cells(4, ar(2)).Value, .Cells(4, ar(3)).Value)
s = s + 1
For i = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Weekday(.Cells(i, ar(0)), vbMonday) < 5 Then
ReDim Preserve Ay(s)
Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value)
s = s + 1
Else
ReDim Preserve Ay(s)
Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value)
s = s + 1
ReDim Preserve Ay(s)
Ay(s) = Array("", "", "", "")
s = s + 1
End If
Next
With Sheets(Sheets("資料來源").[B3].Text)
Rng.Copy .[A1]
With .Range(.[A3], .Cells(.Rows.Count, 6))
.ClearContents
.Columns(1).NumberFormat = "yyyy/mm/dd"
End With
.[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
.Columns("A").AutoFit
End With
End With
End Sub

複製代碼

學海無涯_不恥下問

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

3^#

發表於 2011-4-4 10:36 | 只看該作者

愛死你了 Hsieh 大大
怎麼那麼厲害，才沒幾分鐘的時間，就完成了。
我想要的結果都出來了，可是看不太懂程式的運作，實在太高深了。可以麻煩大大講解一下重點嗎?

Jess

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

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

4^#

發表於 2011-4-4 10:52 | 只看該作者

回復 3# jesscc

Sub SourceData_S()
Dim Ay()
With Worksheets("資料來源")
Set Rng = .Range("A3:B3")
fs = False
If .Range("B3").Value = "" Then
MsgBox "無法取得股票名稱,請確定股票名稱已填入B3儲存格", 32, "資料錯誤!"
Exit Sub
End If
For Each sh In Sheets '檢查工作表名稱是否存在
If sh.Name = .[B3].Text Then fs = True: Exit For
Next
If fs = False Then Sheets.Add.Name = .[B3].Text '如果工作表不存在就新增工作表
ar = Array("A", "C", "I", "P") '需要提取的欄位
ReDim Preserve Ay(s) '，將標題列存入陣列的第一筆並擴大陣列
Ay(s) = Array(.Cells(4, ar(0)).Value, .Cells(4, ar(1)).Value, .Cells(4, ar(2)).Value, .Cells(4, ar(3)).Value)
s = s + 1
For i = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row '進入資料迴圈
If Weekday(.Cells(i, ar(0)), vbMonday) < 5 Then '判斷日期為星期幾，星期5以前執行
ReDim Preserve Ay(s) '將資料存入陣列
Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value)
s = s + 1
Else '星期五執行
ReDim Preserve Ay(s) '將資料存入陣列
Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value)
s = s + 1
ReDim Preserve Ay(s) '儲存一個空白列到陣列
Ay(s) = Array("", "", "", "")
s = s + 1
End If
Next
With Sheets(Sheets("資料來源").[B3].Text)
Rng.Copy .[A1] '股票名稱
With .Range(.[A3], .Cells(.Rows.Count, 6))
.ClearContents '清除原來資料
.Columns(1).NumberFormat = "yyyy/mm/dd" '設定A欄為日期格式
End With
.[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ay)) '將陣列值寫入工作表
.Columns("A").AutoFit 'A欄自動欄寬
End With
End With
End Sub

複製代碼

學海無涯_不恥下問

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

5^#

發表於 2011-4-4 10:59 | 只看該作者

實在佩服到五體投地，強!

Jess

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

6^#

發表於 2011-4-4 15:59 | 只看該作者

大大又來麻煩您了，真不好意思。本來我是想自己修改的，可是研究了一下午，能力實在不夠，改不出來。

是這樣的，我想在新增的工作表中再同時加入C1及E2文字和D1(利用DDE取值=YES|DQ!'2882.Capital')，2882是股票代號，利用"資料來源"工作表中的A3取得。
然後在E欄，從E3以下開始計算C3*D3/D1,C4*D4/D1,C5*D5/D1,.....，不知該怎麼做?

還有一點也是剛剛發現的，假設現在"國泰金"有新資料(2011/1/17開始)，要加入到舊資料2011/1/14之後，要如何做才會貼到舊資料之後，而不會覆蓋掉舊資料?

已附上新測試檔

Jess

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

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

7^#

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

回復 6# jesscc

Sub SourceData_S()
Dim Ay()
With Worksheets("資料來源")
Set Rng = .Range("A3:B3")
fs = False
If .Range("B3").Value = "" Then
MsgBox "無法取得股票名稱,請確定股票名稱已填入B3儲存格", 32, "資料錯誤!"
Exit Sub
End If
For Each sh In Sheets '檢查工作表名稱是否存在
If sh.Name = .[B3].Text Then fs = True: Exit For
Next
If fs = False Then Sheets.Add.Name = .[B3].Text '如果工作表不存在就新增工作表
ar = Array("A", "C", "I", "P") '需要提取的欄位
If fs = False Then '如果是新增工作表，就存入標題
ReDim Preserve Ay(s) '將標題列存入陣列的第一筆並擴大陣列
Ay(s) = Array(.Cells(4, ar(0)).Value, .Cells(4, ar(1)).Value, .Cells(4, ar(2)).Value, .Cells(4, ar(3)).Value, "成交量占股本比例")
s = s + 1
End If
For i = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row '進入資料迴圈
If Weekday(.Cells(i, ar(0)), vbMonday) < 5 Then '判斷日期為星期幾，星期5以前執行
ReDim Preserve Ay(s) '將資料存入陣列
Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value, "=RC[-2]*RC[-1]/R1C4")
s = s + 1
Else '星期五執行
ReDim Preserve Ay(s) '將資料存入陣列
Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value, "=RC[-2]*RC[-1]/R1C4")
s = s + 1
ReDim Preserve Ay(s) '儲存一個空白列到陣列
Ay(s) = Array("", "", "", "", "")
s = s + 1
End If
Next
With Sheets(Sheets("資料來源").[B3].Text)
Rng.Copy .[a1] '股票名稱
.[C1] = "股本(張)": .[D1].FormulaLocal = "=YES|DQ!'" & .[a1] & ".Capital'*1000"
With .Range(.[A3], .Cells(.Rows.Count, 6))
'.ClearContents '清除原來資料
.Columns(1).NumberFormat = "yyyy/mm/dd" '設定A欄為日期格式
End With
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(s, 5) = Application.Transpose(Application.Transpose(Ay)) '將陣列值寫入工作表
.Columns("A:E").AutoFit 'A:E欄自動欄寬
End With
End With
End Sub

複製代碼

學海無涯_不恥下問

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

8^#

發表於 2011-4-4 17:09 | 只看該作者

收到了。
您真是大愛之人，今後要認真向您學習。
謝謝!

Jess

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

9^#

發表於 2011-4-6 12:25 | 只看該作者

Hsieh 大
我研究了兩天還是有很多問題
4、5、11行的 Rng、fs、sh 是保留字嗎?
儲存格的選取有好多種方式，到底有什麼差別?如6、35行
另外第41行，整行都看不懂@@

Jess

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

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

10^#

發表於 2011-4-6 14:13 | 只看該作者

回復 9# jesscc

Rng,sh,fs這些不叫保留字，這些稱為變數
由自己幫某個隨時變動的值，所取名字，就像國中數學的代數是同樣的意義
至於儲存格的寫法有很多
標準寫法Cells(row,column)
在括號內輸入列號與欄號
這是指定單一儲存格的標準寫法
要指定範圍時Range(address)
在括號內輸入範圍的位址字串
這是指定範圍的標準寫法
另一種以中括號表示的方法[name]
此法是一種物件包裝寫法，括號內輸入的是代表範圍的名稱
如[A1]，A1在工作表中所擁有的意義是指，第一列第一欄儲存格的名字
至於第41行.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(s,5)
這是標準的CELLS寫法，你必須拆開來解釋就能了解
.Cells(.Rows.Count, 1)括號中第一個引數是列號，這裏使用.Rows.Count
是因為現在EXCEL的版本不同，工作表的總列數會不同
你是2003版本所以這裡改成65536也是一樣的
這是要得到A欄最底下一列的儲存格
End(xlUp)是向上到資料的最底部
Offset(1, 0)是向下一格的位置
Resize(s,5)是基準儲存格位置向下s列向右5欄擴展的範圍

學海無涯_不恥下問