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

oak0723-1

以下是小弟經過oobird 大大指導寫的程式碼
只是實務應用上操作卻發生過於緩慢狀況
不知要如何修改才可以改善效率問題
另外
在工作表1中之資料
最多是74個
最少是0個
dim i%,j%,k%
i = 4
For Each c In Sheet1.[c10:c83]
Sheet2.Cells(i, 3) = c
i = i + 6
Next
j= 4
For Each c In Sheet1.[d10:d83]
Sheet2.Cells(i, 4) = c
j = j + 6
Next
k = 4
For Each c In Sheet1.[e10:e14]
Sheet2.Cells(i, 11) = c
k = k + 6
Next

oobird

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

複製代碼

oak0723-1

回復 2# oobird


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

Hsieh

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

oak0723-1

回復 4# Hsieh


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

Hsieh

回復 5# oak0723-1


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

oak0723-1

回復 6# Hsieh


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

oobird

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

oak0723-1

回復 8# oobird


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

oobird

看起來你大概想這樣：

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

複製代碼