[發問] 改善效率問題--for-each-next

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

2^#

發表於 2010-8-31 15:42 | 只看該作者

Sub yy()
Dim a, r%, i%, arr()
a = Sheet1.[c10].CurrentRegion
r = 1
For i = 1 To UBound(a)
ReDim Preserve arr(1 To 3, 1 To r)
arr(1, r) = a(i, 1): arr(2, r) = a(i, 2): arr(3, r) = a(i, 3)
r = r + 6
Next
Sheet2.[c4].Resize(r - 6, 2) = Application.Transpose(arr)
Sheet2.[k4].Resize(r - 6, 1) = Application.Transpose(Application.Index(arr, 3))
End Sub

複製代碼

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

3^#

發表於 2010-8-31 16:34 | 只看該作者

本帖最後由 oak0723-1 於 2010-8-31 18:16 編輯

回復 2# oobird

請問
oobird 大大指導寫的程式碼
經執行(詳附件)
會卡在
For i = 1 To UBound(a)
而無法往下繼續執行
另原本工作表1在實務運用上資料應與工作表1-1類似
不過要做與工作表2連結的資料
僅為工作表1之儲存格c10:e83這區域
另外
小弟真的找不到"Transpose"這個說明
所以不懂這意義

990831-2.rar (29.52 KB)

Hsieh

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

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

4^#

發表於 2010-8-31 18:09 | 只看該作者

本帖最後由 Hsieh 於 2010-8-31 18:11 編輯

回復 4# oak0723-1
先去了解基本語法
a = Sheet("1").[c10].CurrentRegion
或
a = Sheet2.[c10].CurrentRegion

學海無涯_不恥下問

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

5^#

發表於 2010-8-31 18:38 | 只看該作者

回復 4# Hsieh

請問
oobird 大大指導寫的程式碼
經執行(詳附件)
會卡在
For i = 1 To UBound(a)
而無法往下繼續執行
另原本工作表1在實務運用上資料應與工作表1-1類似
不過要做與工作表2連結的資料
僅為工作表1之儲存格c10:e83這區域
另外
小弟真的找不到"Transpose"這個說明
所以不懂這意義

990831-2.rar (29.52 KB)

Hsieh

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

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

6^#

發表於 2010-8-31 18:51 | 只看該作者

回復 5# oak0723-1

Sheet1是Sheets("2")
你這樣指到的a是Nothing所以出錯
Transpose請看工作表函數說明
簡單解釋:轉置

學海無涯_不恥下問

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

7^#

發表於 2010-8-31 19:42 | 只看該作者

本帖最後由 oak0723-1 於 2010-8-31 19:50 編輯

回復 6# Hsieh

對不起
再請教大大
在vba環境中要使用工作表函數時
不是應該使用以下語法嗎?
"application.worksheetfunction.工作表函數名稱"
還是還有其他種語法?
另外
若工作表1內容改成如附件0831-3
但仍然欲做之前0831-2動作
應該如何修改程式碼oobird大大所寫的程式碼?

990831-2.rar (12.63 KB)

990831-3.rar (31.3 KB)

oobird

　頭銜: 街友一族

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

8^#

發表於 2010-8-31 20:53 | 只看該作者

這回欄位增多了，你得要讓人明白你想得到的結果是什麼樣子。

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

9^#

發表於 2010-8-31 21:53 | 只看該作者

回復 8# oobird

抱歉oobird大大
小弟實務上的資料如檔案990831-3一樣
但想要做的動作是如檔案990830-2一樣
我沒想到2者會跟寫程式牽連這麼大
下次若有問題我考慮詳細再完整提出
真是抱歉~~~~

oobird

　頭銜: 街友一族

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

10^#

發表於 2010-8-31 22:01 | 只看該作者

看起來你大概想這樣：

Private Sub CommandButton1_Click()
Dim a, r%, i%, arr()
With Sheets("1")
a = .Range(.[c10], .[e10].End(4))
End With
r = 1
For i = 1 To UBound(a)
ReDim Preserve arr(1 To 3, 1 To r)
arr(1, r) = a(i, 1): arr(2, r) = a(i, 2): arr(3, r) = a(i, 3)
r = r + 6
Next
Sheets("2").[c4].Resize(r - 6, 2) = Application.Transpose(arr)
Sheets("2").[k4].Resize(r - 6, 1) = Application.Transpose(Application.Index(arr, 3))
End Sub

複製代碼