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

jesscc

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

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

以上是目前我所碰到的問題，希望各位高手能教教我，感恩不盡。

Hsieh

回復 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

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

Hsieh

回復 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

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

jesscc

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

是這樣的，我想在新增的工作表中再同時加入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

回復 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

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

jesscc

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

Hsieh

回復 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欄擴展的範圍