如何用數組OR 其他方法加速?

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

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

1^# 跳轉到 »

發表於 2011-3-16 07:33 | 顯示全部帖子

請問大大如何用數組 MYarr() 加速 OR 其他方法加速以下的碼?
因為圖太多,加入時很慢
basarasy 發表於 2011/3/15 22:08

可能這就是原因吧!

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

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

2^#

發表於 2011-3-16 10:57 | 顯示全部帖子

回復 GBKEE

請問GBKEE大大,在For Next 時 ,可以用數組加速嗎?
basarasy 發表於 2011/3/16 08:59

問題是圖片太多插入工作表費時!
換個方式來顯示看看

圖片顯示.rar (336.15 KB)

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

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

3^#

發表於 2011-3-16 16:53 | 顯示全部帖子

本帖最後由 GBKEE 於 2011-3-16 16:56 編輯

回復 5# basarasy
請修改圖片.xls 的 CommandButton1_Click
再刪掉 ComboBox1_Change()
試試看是否如你的想法

Private Sub CommandButton1_Click()
Dim A, i
With Application.FileDialog(msoFileDialogOpen)
.Title = "尋找圖片檔"
''''''''''''''''''''''''''''''''''''''''''''
.InitialView = msoFileDialogViewThumbnail
'設定 InitialView 屬性為顯示圖片
''''''''''''''''''''''''''''''''''''''''''''''
.AllowMultiSelect = False '不允許多重選取檔案
.ButtonName = "開啟圖片檔"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
.FilterIndex = 1
If .Show Then
Image1.Picture = LoadPicture(.SelectedItems(1))
Else
Image1.Picture = LoadPicture(LPicture)
End If
End With
End Sub

複製代碼

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

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

4^#

發表於 2011-3-16 21:15 | 顯示全部帖子

請問大大如何用數組 MYarr() 加速 OR 其他方法加速以下的碼?
因為圖太多,加入時很慢
basarasy 發表於 2011/3/15 22:08

你的例子不是回到原點嗎?

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

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

5^#

發表於 2011-3-17 07:28 | 顯示全部帖子

回復 9# basarasy
修改你1樓的程式如下

Private Sub Ex()
Dim Ps, Pc, A
With Application.FileDialog(msoFileDialogOpen)
.Title = "尋找圖片檔"
.AllowMultiSelect = True '多重選取檔案
.ButtonName = "開啟圖片檔"
.InitialView = msoFileDialogViewThumbnail
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
.FilterIndex = 1
If .Show = False Then
MsgBox "沒有選擇任何圖片檔", vbOKOnly + vbExclamation: Exit Sub
Else
Set Ps = .SelectedItems
End If
End With
Application.ScreenUpdating = False
With Sheet3
.Range("A2:d20000").Clear 'A2以下清除 (全部)
.Range("A2:d20000").EntireRow.AutoFit '恢復為標準列高
.Pictures.Delete
Set A = .Range("A2")
For Each Pc In Ps
A.Value = A.Row - 1
.Hyperlinks.Add Anchor:=A.Cells(1, 3), Address:=Pc, TextToDisplay:=Pc
With .Pictures.Insert(Pc)
.Height = 34
.Width = 54
.Left = A.Offset(, 3).Left
.Top = A.Offset(, 3).Top
End With
Set A = A.Offset(1)
Next
'.Shapes.SelectAll
.Pictures.Placement = xlMoveAndSize
.Range("a1:c1").EntireColumn.AutoFit '自動調整欄寬
.Range("A2:a" & .Range("A2").End(xlDown)).RowHeight = 34 '設定列高
End With
Sheet1.Select
Application.ScreenUpdating = True
ActiveSheet.Range("A2").Select
MsgBox "插入完成"
End Sub

複製代碼