Board logo

標題: [發問] 原有工作表中不同欄位資料，轉移到新產生工作表中，並重新安排位置(已解決) [打印本頁]
作者: jesscc    時間: 2011-4-4 09:05     標題: 原有工作表中不同欄位資料，轉移到新產生工作表中，並重新安排位置(已解決)

本帖最後由 jesscc 於 2011-4-7 00:07 編輯

各位高手好，小弟初學，碰到許多瓶頸解不開，還望各位解惑。是這樣的，我的工作如下述:
按下"資料來源"工作表中的"資料轉移"按鈕後，會建立一個新工作表，新工作表名稱將以"資料來源"工作表中的B3命名，然後把"資料來源"工作表中相關數據貼到這個新產生的工作表中，如同"股票A"工作表的安排那樣。

但是現在只寫到建立新的工作表，頭殼已經快爆了，因為在建立新工作表的同時，還要判斷"資料來源"工作表中
1.B3是否為空值(這部分已解決)
2.以B3為名稱的工作表是否已存在，若已存在，就不用建立新的工作表，只貼入資料即可
3.相同的日期，是否在相同一列上

以上是目前我所碰到的問題，希望各位高手能教教我，感恩不盡。
作者: Hsieh    時間: 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
複製代碼
作者: jesscc    時間: 2011-4-4 10:36

愛死你了 Hsieh 大大
怎麼那麼厲害，才沒幾分鐘的時間，就完成了。
我想要的結果都出來了，可是看不太懂程式的運作，實在太高深了。可以麻煩大大講解一下重點嗎?
作者: Hsieh    時間: 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
複製代碼
作者: jesscc    時間: 2011-4-4 10:59

實在佩服到五體投地，強!
作者: jesscc    時間: 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之後，要如何做才會貼到舊資料之後，而不會覆蓋掉舊資料?

已附上新測試檔
作者: Hsieh    時間: 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
複製代碼
作者: jesscc    時間: 2011-4-4 17:09

收到了。
您真是大愛之人，今後要認真向您學習。
謝謝!
作者: jesscc    時間: 2011-4-6 12:25

Hsieh 大
我研究了兩天還是有很多問題
4、5、11行的 Rng、fs、sh 是保留字嗎?
儲存格的選取有好多種方式，到底有什麼差別?如6、35行
另外第41行，整行都看不懂@@
作者: Hsieh    時間: 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欄擴展的範圍
作者: jesscc    時間: 2011-4-6 15:04

也就是說第4行
Set Rng = .Range("A3:B3")
可以寫成
Set Rng = .[A3:B3]
是這樣嗎?

另外
Resize(s,5)括號中的s就是第18行的s嗎?
作者: Hsieh    時間: 2011-4-6 18:09

回復 11# jesscc

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

S就是陣列到最後會有的元素數量
因為該陣列是二維陣列
每個元素是由一維陣列所組成
因為你的資料在星期五後面要增加一個空白列
所以S會是所有資料加上幾個星期五的數量
作者: bobby0204    時間: 2011-6-14 15:25

Hsieh 大大
我有一個類似的問題
想請問
方便嗎?



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)