帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2011-6-5 23:06 | 只看該作者

[發問] 用二維陣列，轉不出來資料

本帖最後由 jesscc 於 2011-6-5 23:08 編輯

上次承蒙前輩教了我用二維陣列轉多欄位的資料，最近試作了一個檔案，可是資料轉不出來，不知哪裡出了問題，能請各位前輩幫忙看一下嗎?

我的工作是這樣的:
1.在 Test.xlsm 中的 Sheets("AA") 按下按鈕"POR"，會自動轉存成一份 "日期"+"已出貨.xlsx" 檔，格式跟原來的 Test.xlsm 是一模一樣的，但沒有任何資料。
2.接著程式會把 Test.xlsm 中 AA、BB、CC 三個工作頁的 B 欄位中只要有 "v" 及 "*" 的那一列資料分別存入空白的 "日期"+"已出貨.xlsx" 檔

Test.rar (59.69 KB)

樓主熱帖

Jess

jesscc

中學生 Rank: 2

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

5^#

發表於 2011-6-6 22:30 | 只看該作者

原來只要檢查陣列中有無存入資料即可。
感謝 Hsieh 大再一次的幫忙，祝福你端午節愉快!

Jess

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 255
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2011-6-6 22:06 | 只看該作者

回復 3# jesscc

if s>0 then wb.Sheets(.Name).[B7].Resize(s, 10) = Application.Transpose(Application.Transpose(Ay))

學海無涯_不恥下問

TOP

jesscc

中學生 Rank: 2

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

3^#

發表於 2011-6-6 20:48 | 只看該作者

好像不需要用到二維陣列，是我想太多了。

不過，Hsieh大大，剛剛試了一下發現，如果在B欄位都沒有標記 "v" 或 "*" 的情形下，沒辦法另存出正確的活頁簿檔名(我的想法是，至少它應該會存成一個空白無資料的新活頁簿)，而且會在這一行出現偵錯
wb.Sheets(.Name).[B7].Resize(s, 10) = Application.Transpose(Application.Transpose(Ay))

Jess

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 255
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-24

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2011-6-6 14:20 | 只看該作者

回復 1# jesscc

Sub ContainerDetails()
Set swb = ThisWorkbook
mypath = "C:\Documents and Settings\Administrator\桌面\"
myfile = Format(Date, "emmdd") & "已出貨.xlsx"
swb.Sheets(Array("AA", "BB", "CC")).Copy
Set wb = ActiveWorkbook
wb.Sheets("AA").Shapes.Range(Array("CommandButton6")).Delete
wb.Sheets("AA").Range("B7:J500").ClearContents
wb.Sheets("BB").Range("B7:J500").ClearContents
wb.Sheets("CC").Range("B7:J500").ClearContents
For Each Sh In swb.Sheets(Array("AA", "BB", "CC"))
Dim Ay()
With Sh
For i = 7 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Range("B" & i) = "v" Or .Range("B" & i) = "*" Then
ReDim Preserve Ay(s)
Ay(s) = .Range("B" & i).Resize(, 10).Value
s = s + 1
End If
Next
wb.Sheets(.Name).[B7].Resize(s, 10) = Application.Transpose(Application.Transpose(Ay))
Erase Ay
s = 0
End With
Next
wb.SaveAs mypath & myfile
End Sub

複製代碼

學海無涯_不恥下問

TOP