返回列表 上一主題 發帖

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

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

以下是小弟經過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

990831-1.rar (5.79 KB)

  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. End Sub
複製代碼

TOP

本帖最後由 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)

TOP

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

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

a = Sheet2.[c10].CurrentRegion
學海無涯_不恥下問

TOP

回復 4# Hsieh


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

990831-2.rar (29.52 KB)

TOP

回復 5# oak0723-1


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

TOP

本帖最後由 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)

TOP

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

TOP

回復 8# oobird


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

TOP

看起來你大概想這樣:
  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
複製代碼

TOP

        靜思自在 : 信心、毅力、勇氣三者具備,則天下沒有做不成的事。
返回列表 上一主題