[發問] 隔列複製資料至另一工作表，依對應欄位貼上

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

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

2^#

發表於 2010-5-25 08:44 | 只看該作者

回復 1# viggostar

Sub Ex()
Dim Ar(), Ay(6), Rng As Range, CLM$, A As Range, i%, s&
With Sheet1
CLM = "CLKMPY"
Set Rng = .Range(.[C3], .[C65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
For Each A In Rng
For i = 1 To 6
Ay(i - 1) = .Cells(A.Row, Mid(CLM, i, 1)).Value
Next
ReDim Preserve Ar(s)
Ar(s) = Ay
s = s + 1
Next
End With
Sheet2.[A65536].End(xlUp).Offset(1, 0).Resize(s, 6) = Application.Transpose(Application.Transpose(Ar))
End Sub

複製代碼

學海無涯_不恥下問

viggostar

小學生 Rank: 1

帖子: 5
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: windows XP
軟體版本: Office 2003
閱讀權限: 10
註冊時間: 2010-5-9
最後登錄: 2013-4-9

3^#

發表於 2010-5-25 22:20 | 只看該作者

回復 2# Hsieh

感謝板主的回覆
另有些問題再請教一下
1. CLM = "CLKMPY" 這部份，在我實際的檔案中，複製的是V、AA、AD、AO欄
嘗試將""裡的值改在"VAAADAY"或"V" & ""AA" & "AD" & "AO"，帶出來的值都不對，請問我該如何設定呢？
2. 實際檔案中"order"的a欄有數字，若使用板主您的程式碼，資料會貼在"order"工作表的第19列~
且第1項中貼上的欄位在order工作表中並不連續，該如何解決呢？
(今天上傳的已是實際使用的檔案)
感謝幫忙！

Report_SAMPLE.rar (206.01 KB)

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

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

4^#

發表於 2010-5-25 23:17 | 只看該作者

回復 3# viggostar

Sub Ex()
Dim Ar(), Ay(4), Rng As Range, Ck(), Kr(), A As Range, i%, s&
With Sheet1
Ck = Array("V", "AD", "AO", "AA")
Kr = Array("C", "E", "H", "K")
Set Rng = .Range(.[C5], .[C65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
For Each A In Rng
For i = 0 To 3
Ay(i) = "'" & .Cells(A.Row, Ck(i))
Next
ReDim Preserve Ar(s)
Ar(s) = Ay
s = s + 1
Next
End With
For i = 0 To UBound(Ar)
Set A = Sheet3.[C65536].End(xlUp).Offset(1, 0)
For j = 0 To 3
Sheet3.Cells(A.Row, Kr(j)) = Ar(i)(j)
Next
Next
End Sub

複製代碼

學海無涯_不恥下問

viggostar

小學生 Rank: 1

帖子: 5
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: windows XP
軟體版本: Office 2003
閱讀權限: 10
註冊時間: 2010-5-9
最後登錄: 2013-4-9

5^#

發表於 2010-5-26 22:50 | 只看該作者

回復 4# Hsieh

可以了，感謝板主！

如果麻煩您逐行解說程式碼的意思，是不是會太過份 >"<

我知道有用到定義、迴圈

但 redim preserve 的意思不了解

為什麼可以只有with sheet1來執行

不需要指定sheet的名字是 order 或 detail

第一行的i、s後為什麼要加%、&完全不懂…

真的很不好意思麻煩你

若您有空再麻煩你回答我

感謝您~

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

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

6^#

發表於 2010-5-27 08:54 | 只看該作者

回復 5# viggostar

Preserve 選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。
也就是說陣列大小改變後,仍保留原有的元素
例如宣告一陣列Ar()
若用Redim Ar(5)
那不管之前給過Ar(0),Ar(1),...有甚麼值
經ReDim以後這些值就全部被清除了

Dim Ar(4)
for i=0 to 3
Ar(i)=i
next
上面敘述你已經將原陣列Ar(0)~Ar(3)給過值
現在要擴大成5個元素但要保留Ar(0)~Ar(3)的值
ReDim Preserve Ar(5)
Ar(4)=4
你再測試
for i= 0 to UBound(Ar)
msgbox "Ar(" & i & ")=" & Ar(i)
next

學海無涯_不恥下問

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

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

7^#

發表於 2010-5-27 09:02 | 只看該作者

回復 5# viggostar

為什麼可以只有with sheet1來執行
不需要指定sheet的名字是 order 或 detail
Sheet1是用工作表的CodeName不會因工作表更名而改變
order 或 detail是工作表的Name會因工作表更名而改變

變數的資料型態
在 Visual Basic 可用符號 (&) 的型態宣告字元來表示一個 Long
在 Visual Basic 可用百分比符號 (%) 的型態宣告字元來表示一個 Integer。
在 Visual Basic 可用 @ 宣告字元來表示 Currency
在 Visual Basic 中可用型態宣告字元 (!) 來表示一個 Single。
在 Visual Basic，符號 (#) 是表示 Double 的型態宣告字元

學海無涯_不恥下問

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2010-5-27 16:38 | 只看該作者

回復 4# Hsieh
純參考可以簡化一下程式碼
Sub Ex()
Dim Ck(), Kr(), i%
Ck = Array("V", "AD", "AO", "AA")
Kr = Array("C", "E", "H", "K")
With Sheet1
      For i = 0 To UBound(Ck)
         With .Range(Ck(i) & 5, .Range(Ck(i) & 65536).End(xlUp)).SpecialCells(xlCellTypeVisible)
            .copy Sheet3.Range(Kr(i) & 65536).End(xlUp).Offset(1, 0)
         End With
      Next
End With
End Sub

viggostar

小學生 Rank: 1

帖子: 5
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: windows XP
軟體版本: Office 2003
閱讀權限: 10
註冊時間: 2010-5-9
最後登錄: 2013-4-9

9^#

發表於 2010-5-28 23:46 | 只看該作者

非常感謝Hsieh版主的解說，還麻煩您給了那麼多資料
趁假日剛好努力鑽研

感謝！^^
ps. GBKEE版主的我也會試試看, 謝謝喔^^