[發問] 如何讀取另一個xls裡的sheets資料到array裡以便處理

kasl

請問如何在不開檔的情況下 去開啟另一個xls裡的四個sheets(open,close,high,low)
存到四個不同的array裡 以便做後續的處理 謝謝
我找到一個比較像的例子 但我改不出來
煩請各位指教

Sub get_word_table( )
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application") '建立引用Word應用程式的物件
Set wrdDoc = wrdApp.Documents.Open("D:\Temp\ole_test.doc") '引用Word文件
With wrdDoc.Tables(1)
　For r = 1 To .Rows.Count
　　For c = 1 To .Columns.Count
　　Cells(r, c) = .Cell(r, c)
　　Next c
　Next r
End With
wrdDoc.Close 'close the document
wrdApp.Quit 'close Word
Set wrdDoc = Nothing '釋放物件變數
Set wrdApp = Nothing
End Sub

iceandy6150

回復 1# kasl

我貼之前來這發問的範例，您再改改看

不同檔案間的複製
Sub ex()
Dim Ar(), fd$, fs$, s%
fd = "D:\10月\" '更改成你的10月資料夾目錄    *****這邊你就改你想開的檔案的資料夾目錄
fs = Dir(fd & "*.xls")
Do Until fs = ""
With Workbooks.Open(fd & fs)
   With .Sheets("模製")
   ReDim Preserve Ar(s)
      Ar(s) = Array(.[AP7].Value, .[AP10].Value, .[AP12].Value, .[G7].Value, .[G12].Value)
      s = s + 1
   End With
   .Close 0
End With
fs = Dir
Loop
[A2].Resize(s, 5).Value = Application.Transpose(Application.Transpose(Ar))
End Sub


我想重點在
With Workbooks.Open(fd & fs)   
fd是設資料夾目錄   (例如  C:\test\abc  --->C槽裡，test資料夾裡，abc資料夾)
fs是設檔名+.xls  (例如  001.xls)  
那fd&fs就會是C:\test\abc\001.xls
然後With Workbooks.Open(fd & fs)就變成With Workbooks.Open(C:\test\abc\001.xls)
就會去開001.xls檔了

With .Sheets("模製")的功能是讓你使用該工作表
所以你可以改寫成With .Sheets(" ")     兩個"中間放入你的工作表的名字

然後再去讀資料，複製到現用的檔案裡面的某一個工作表(sheet)中的陣列
這邊我就不太會了，不好意思，我也是新手

希望對你有一點幫助

kasl

小弟自問自答一下

Sub Get_Stock_Table()

Dim ExcApp As Object

Set ExcApp = CreateObject("Excel.Application") '建立引用Word應用程式的物件
Set ExcDoc = ExcApp.Workbooks.Open("D:\開高低收.xls") '引用Word文件

Dim AR_Open, AR_High, AR_Low, AR_Close

With ExcDoc.Worksheets("Open")
  AR_Open = .UsedRange.Value
End With

With ExcDoc.Worksheets("High")
  AR_High = .UsedRange.Value
End With

With ExcDoc.Worksheets("Low")
  AR_Low = .UsedRange.Value
End With

With ExcDoc.Worksheets("Close")
  AR_Close = .UsedRange.Value
End With


ExcDoc.Close 'close the document
ExcApp.Quit 'close Excel
Set ExcDoc = Nothing '釋放物件變數
Set ExcApp = Nothing

End Sub

不知中間那幾個行重覆做的 怎麼用loop的方式把他們合起來寫
謝謝~

GBKEE

回復 3# kasl
試試看

1. Option Explicit
   
2. Sub Get_Stock_Table()
   
3. Dim ExcApp As Workbook, AR(0 To 3), Sh, i As Integer
   
4. 
   
5. 'Set ExcApp = CreateObject("Excel.Application") '建立引用Word應用程式的物件
   
6. '??? Excel.Applicationg 是 Excel應用程式的物件****
   
7. 'Set ExcDoc = ExcApp.Workbooks.Open("D:\開高低收.xls") '引用Word文件
   
8. '??? 這xls是Excel檔
   
9. 
   
10. '**** 開啟的是xls ****
    
11. Set ExcApp = Workbooks.Open("D:\開高低收.xls") '開啟excel檔
    
12. Sh = Split("Open,High,Low,Close", ",")
    
13. With ExcApp
    
14.     For i = 0 To UBound(Sh)
    
15.         AR(i) = .Worksheets(Sh(i)).UsedRange
    
16.     Next
    
17. End With
    
18. ExcApp.Close 'Close the Workbook
    
19. 'Set ExcApp = Nothing '釋放物件變數
    
20. 'ExcApp:程式的私用變數,程式結束就被釋放掉,不必再 Set ExcApp = Nothing
    
21. End Sub

複製代碼

kasl

謝謝版主您的回答
不過 "開高低收.xls" 裡面放的是200隻個股近三年來每天的開盤、最高、最低、收盤價，打算用四個二維陣列來存放
我回家後再來想怎麼讓他 work，謝謝 ~

kasl

試了一下您提供的程式 可以用
謝謝
我再來寫其它的功能