返回列表 上一主題 發帖

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

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

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

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

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

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

Test.rar (22.33 KB)

測試檔

按鈕.rar (25.88 KB)

測試檔

Jess

回復 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 大大
怎麼那麼厲害,才沒幾分鐘的時間,就完成了。
我想要的結果都出來了,可是看不太懂程式的運作,實在太高深了。可以麻煩大大講解一下重點嗎?
Jess

TOP

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

實在佩服到五體投地,強!
Jess

TOP

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

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

TOP

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

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

TOP

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

TOP

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

        靜思自在 : 每天無所事事,是人生的消費者,積極、有用才是人生的創造者。
返回列表 上一主題