返回列表 上一主題 發帖

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

Hsieh

帖子
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兔年全勤獎章
1# 跳轉到 »
發表於 2011-4-4 09:58 | 顯示全部帖子
回復 1# jesscc
  1. Sub SourceData_S()
  2. Dim Ay()
  3. With Worksheets("資料來源")
  4.     Set Rng = .Range("A3:B3")
  5.     fs = False
  6.     If .Range("B3").Value = "" Then
  7.     MsgBox "無法取得股票名稱,請確定股票名稱已填入B3儲存格", 32, "資料錯誤!"
  8.     Exit Sub
  9.     End If
  10.     For Each sh In Sheets
  11.        If sh.Name = .[B3].Text Then fs = True: Exit For
  12.     Next
  13.     If fs = False Then Sheets.Add.Name = .[B3].Text
  14.     ar = Array("A", "C", "I", "P")
  15.     ReDim Preserve Ay(s)
  16.     Ay(s) = Array(.Cells(4, ar(0)).Value, .Cells(4, ar(1)).Value, .Cells(4, ar(2)).Value, .Cells(4, ar(3)).Value)
  17.     s = s + 1
  18.     For i = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
  19.        If Weekday(.Cells(i, ar(0)), vbMonday) < 5 Then
  20.           ReDim Preserve Ay(s)
  21.           Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value)
  22.           s = s + 1
  23.           Else
  24.           ReDim Preserve Ay(s)
  25.           Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value)
  26.           s = s + 1
  27.           ReDim Preserve Ay(s)
  28.           Ay(s) = Array("", "", "", "")
  29.           s = s + 1
  30.         End If
  31.     Next
  32.     With Sheets(Sheets("資料來源").[B3].Text)
  33.     Rng.Copy .[A1]
  34.     With .Range(.[A3], .Cells(.Rows.Count, 6))
  35.        .ClearContents
  36.        .Columns(1).NumberFormat = "yyyy/mm/dd"
  37.     End With
  38.     .[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ay))
  39.     .Columns("A").AutoFit
  40.     End With
  41.     End With
  42. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
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兔年全勤獎章
2#
發表於 2011-4-4 10:52 | 顯示全部帖子
回復 3# jesscc
  1. Sub SourceData_S()
  2. Dim Ay()
  3. With Worksheets("資料來源")
  4.     Set Rng = .Range("A3:B3")
  5.     fs = False
  6.     If .Range("B3").Value = "" Then
  7.     MsgBox "無法取得股票名稱,請確定股票名稱已填入B3儲存格", 32, "資料錯誤!"
  8.     Exit Sub
  9.     End If
  10.     For Each sh In Sheets '檢查工作表名稱是否存在
  11.        If sh.Name = .[B3].Text Then fs = True: Exit For
  12.     Next
  13.     If fs = False Then Sheets.Add.Name = .[B3].Text '如果工作表不存在就新增工作表
  14.     ar = Array("A", "C", "I", "P") '需要提取的欄位
  15.     ReDim Preserve Ay(s) '，將標題列存入陣列的第一筆並擴大陣列
  16.     Ay(s) = Array(.Cells(4, ar(0)).Value, .Cells(4, ar(1)).Value, .Cells(4, ar(2)).Value, .Cells(4, ar(3)).Value)
  17.     s = s + 1
  18.     For i = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row '進入資料迴圈
  19.        If Weekday(.Cells(i, ar(0)), vbMonday) < 5 Then '判斷日期為星期幾，星期5以前執行
  20.           ReDim Preserve Ay(s) '將資料存入陣列
  21.           Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value)
  22.           s = s + 1
  23.           Else '星期五執行
  24.           ReDim Preserve Ay(s) '將資料存入陣列
  25.           Ay(s) = Array(.Cells(i, ar(0)).Text, .Cells(i, ar(1)).Value, .Cells(i, ar(2)).Value, .Cells(i, ar(3)).Value)
  26.           s = s + 1
  27.           ReDim Preserve Ay(s) '儲存一個空白列到陣列
  28.           Ay(s) = Array("", "", "", "")
  29.           s = s + 1
  30.         End If
  31.     Next
  32.     With Sheets(Sheets("資料來源").[B3].Text)
  33.     Rng.Copy .[A1] '股票名稱
  34.     With .Range(.[A3], .Cells(.Rows.Count, 6))
  35.        .ClearContents '清除原來資料
  36.        .Columns(1).NumberFormat = "yyyy/mm/dd" '設定A欄為日期格式
  37.     End With
  38.     .[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ay)) '將陣列值寫入工作表
  39.     .Columns("A").AutoFit 'A欄自動欄寬
  40.     End With
  41.     End With
  42. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
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兔年全勤獎章
3#
發表於 2011-4-4 16:50 | 顯示全部帖子
回復 6# jesscc
  1. Sub SourceData_S()
  2. Dim Ay()
  3. With Worksheets("資料來源")
  4.     Set Rng = .Range("A3:B3")
  5.     fs = False
  6.     If .Range("B3").Value = "" Then
  7.     MsgBox "無法取得股票名稱,請確定股票名稱已填入B3儲存格", 32, "資料錯誤!"
  8.     Exit Sub
  9.     End If
  10.     For Each sh In Sheets '檢查工作表名稱是否存在
  11.        If sh.Name = .[B3].Text Then fs = True: Exit For
  12.     Next
  13.     If fs = False Then Sheets.Add.Name = .[B3].Text '如果工作表不存在就新增工作表
  14.     ar = Array("A", "C", "I", "P") '需要提取的欄位
  15.     If fs = False Then '如果是新增工作表，就存入標題
  16.     ReDim Preserve Ay(s) '將標題列存入陣列的第一筆並擴大陣列
  17.     Ay(s) = Array(.Cells(4, ar(0)).Value, .Cells(4, ar(1)).Value, .Cells(4, ar(2)).Value, .Cells(4, ar(3)).Value, "成交量占股本比例")
  18.     s = s + 1
  19.     End If
  20.     For i = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row '進入資料迴圈
  21.        If Weekday(.Cells(i, ar(0)), vbMonday) < 5 Then '判斷日期為星期幾，星期5以前執行
  22.           ReDim Preserve Ay(s) '將資料存入陣列
  23.           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")
  24.           s = s + 1
  25.           Else '星期五執行
  26.           ReDim Preserve Ay(s) '將資料存入陣列
  27.           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")
  28.           s = s + 1
  29.           ReDim Preserve Ay(s) '儲存一個空白列到陣列
  30.           Ay(s) = Array("", "", "", "", "")
  31.           s = s + 1
  32.         End If
  33.     Next
  34.     With Sheets(Sheets("資料來源").[B3].Text)
  35.     Rng.Copy .[a1] '股票名稱
  36.     .[C1] = "股本(張)": .[D1].FormulaLocal = "=YES|DQ!'" & .[a1] & ".Capital'*1000"
  37.     With .Range(.[A3], .Cells(.Rows.Count, 6))
  38.        '.ClearContents '清除原來資料
  39.        .Columns(1).NumberFormat = "yyyy/mm/dd" '設定A欄為日期格式
  40.     End With
  41.     .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(s, 5) = Application.Transpose(Application.Transpose(Ay)) '將陣列值寫入工作表
  42.     .Columns("A:E").AutoFit 'A:E欄自動欄寬
  43.     End With
  44.     End With
  45. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
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-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欄擴展的範圍
學海無涯_不恥下問

TOP

Hsieh

帖子
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兔年全勤獎章
5#
發表於 2011-4-6 18:09 | 顯示全部帖子
回復 11# jesscc

沒錯
Set Rng = .Range("A3:B3")
可以寫成
Set Rng = .[A3:B3]

S就是陣列到最後會有的元素數量
因為該陣列是二維陣列
每個元素是由一維陣列所組成
因為你的資料在星期五後面要增加一個空白列
所以S會是所有資料加上幾個星期五的數量
學海無涯_不恥下問

TOP

        靜思自在 : 人要自愛，才能愛普天下的人。
返回列表 上一主題