12
返回列表 上一主題 發帖

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

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2011-3-15 22:08 | 只看該作者

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

請問大大如何用 數組 MYarr() 加速 OR 其他方法加速 以下的碼?
因為圖太多,加入時很慢 :'(
  1. Private Sub Ex()
  2.    
  3.     Dim Ps, Pc, A
  4.     With Application.FileDialog(msoFileDialogOpen)
  5.         .Title = "尋找圖片檔"
  6.         .AllowMultiSelect = True   '多重選取檔案
  7.         .ButtonName = "開啟圖片檔"
  8.         .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
  9.         .FilterIndex = 1
  10.         If .Show = False Then
  11.             MsgBox "沒有選擇任何圖片檔", vbOKOnly + vbExclamation : Exit Sub
  12.         Else
  13.            Set Ps = .SelectedItems
  14.         End If
  15.     End With
  16.    
  17. Application.ScreenUpdating = False

  19.     Sheet3.Select
  20.    
  21.     With ActiveSheet
  22.       .Range("A1:A20000").Value = ""
  23.      .Pictures.Delete
  24.     Set A = .Range("A1")
  25.            
  26.     For Each Pc In Ps
  27.                        
  28.     .Hyperlinks.Add Anchor:=A, Address:=Pc, TextToDisplay:=Pc
  29.                
  30.        With .Pictures.Insert(Pc)
  31.             .Height = 34
  32.             .Width = 54
  33.             .Left = A.Offset(, 1).Left
  34.             .Top = A.Offset(, 1).Top
  35.         End With
  36.         Set A = A.Offset(1)
  37.     Next
  38.   
  39.     .Shapes.SelectAll              
  40.     Selection.Placement = xlMoveAndSize
  41.    
  42.     End With
  43.    
  44.     Sheet1.Select
  45.    
  46.     Application.ScreenUpdating = True
  47.       
  48.     Range("A2").Select
  49.         
  50.     MsgBox "插入完成"
  51.   
  52. End Sub
複製代碼
收藏 分享
50 字節以內
不支持自定義 Discuz! 代碼

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
11#
發表於 2011-3-17 19:23 | 只看該作者
回復 10# GBKEE
　謝謝GBKEE大大，試過真的加快了．
50 字節以內
不支持自定義 Discuz! 代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2011-3-17 07:28 | 只看該作者
回復 9# basarasy
修改你1樓的程式如下

  2. Private Sub Ex()
  3.     Dim Ps, Pc, A
  4.     With Application.FileDialog(msoFileDialogOpen)
  5.         .Title = "尋找圖片檔"
  6.         .AllowMultiSelect = True   '多重選取檔案
  7.         .ButtonName = "開啟圖片檔"
  8.         .InitialView = msoFileDialogViewThumbnail
  9.         .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
  10.         .FilterIndex = 1
  11.         If .Show = False Then
  12.             MsgBox "沒有選擇任何圖片檔", vbOKOnly + vbExclamation: Exit Sub
  13.         Else
  14.            Set Ps = .SelectedItems
  15.         End If
  16.     End With
  17.     Application.ScreenUpdating = False
  18.     With Sheet3
  19.         .Range("A2:d20000").Clear                          'A2以下 清除 (全部)
  20.         .Range("A2:d20000").EntireRow.AutoFit              '恢復為標準列高
  21.         .Pictures.Delete
  22.         Set A = .Range("A2")
  23.         For Each Pc In Ps
  24.             A.Value = A.Row - 1
  25.             .Hyperlinks.Add Anchor:=A.Cells(1, 3), Address:=Pc, TextToDisplay:=Pc
  26.             With .Pictures.Insert(Pc)
  27.                 .Height = 34
  28.                 .Width = 54
  29.                 .Left = A.Offset(, 3).Left
  30.                 .Top = A.Offset(, 3).Top
  31.             End With
  32.             Set A = A.Offset(1)
  33.         Next
  34.         '.Shapes.SelectAll
  35.         .Pictures.Placement = xlMoveAndSize
  36.         .Range("a1:c1").EntireColumn.AutoFit                       '自動調整欄寬
  37.         .Range("A2:a" & .Range("A2").End(xlDown)).RowHeight = 34   '設定列高
  38.     End With
  39.     Sheet1.Select
  40.     Application.ScreenUpdating = True
  41.     ActiveSheet.Range("A2").Select
  42.     MsgBox "插入完成"
  43. End Sub
複製代碼

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
9#
發表於 2011-3-16 21:29 | 只看該作者
回復 8# GBKEE

因為圖片一定要放出來给人看，看見圖片才知道注解要打什麼．
50 字節以內
不支持自定義 Discuz! 代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2011-3-16 21:15 | 只看該作者
請問大大如何用 數組 MYarr() 加速 OR 其他方法加速 以下的碼?
因為圖太多,加入時很慢
basarasy 發表於 2011/3/15 22:08

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

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
7#
發表於 2011-3-16 19:54 | 只看該作者
回復 6# GBKEE


    我做了個例子



篩選後
50 字節以內
不支持自定義 Discuz! 代碼

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2011-3-16 16:53 | 只看該作者
本帖最後由 GBKEE 於 2011-3-16 16:56 編輯

回復 5# basarasy
請修改 圖片.xls 的 CommandButton1_Click
再刪掉 ComboBox1_Change()
試試看是否如你的想法
  1. Private Sub CommandButton1_Click()
  2.     Dim A, i
  3.     With Application.FileDialog(msoFileDialogOpen)
  4.         .Title = "尋找圖片檔"
  5.         ''''''''''''''''''''''''''''''''''''''''''''
  6.         .InitialView = msoFileDialogViewThumbnail
  7.         '設定 InitialView 屬性 為顯示圖片
  8.         ''''''''''''''''''''''''''''''''''''''''''''''
  9.         .AllowMultiSelect = False      '不允許 多重選取檔案
  10.         .ButtonName = "開啟圖片檔"
  11.         .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
  12.         .FilterIndex = 1
  13.         If .Show Then
  14.             Image1.Picture = LoadPicture(.SelectedItems(1))
  15.         Else
  16.             Image1.Picture = LoadPicture(LPicture)
  17.         End If
  18.     End With
  19. End Sub
複製代碼

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
5#
發表於 2011-3-16 14:07 | 只看該作者
回復 4# GBKEE
謝謝GBKEE大大的方法.
但有方法像插入圖片的嗎?
因為圖片左邊是 No. 和 给人看圖片 打注解的列
還有用篩選時圖片也只出現篩選了的圖片.
50 字節以內
不支持自定義 Discuz! 代碼

TOP

GBKEE

帖子
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 10:57 | 只看該作者
回復  GBKEE

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

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

圖片顯示.rar (336.15 KB)

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
3#
發表於 2011-3-16 08:59 | 只看該作者
回復 2# GBKEE

請問GBKEE大大,在For  Next 時 ,可以用數組加速 嗎?
50 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 能善用時間的人，必能掌握自己努力的方向。
12
返回列表 上一主題