返回列表 上一主題 發帖

[發問] vba for next用法及效率改善問題

被論文逼瘋的人

帖子
9 
主題
4 
精華
0 
積分
15 
點名
0  
作業系統
windows 10 
軟體版本
office 2010 
閱讀權限
10 
性別
女 
來自
桃園 
註冊時間
2016-5-4 
最後登錄
2016-6-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-5-9 11:02 | 只看該作者

[發問] vba for next用法及效率改善問題

篩選, 迴圈, vba, 效率
之前有發問，但是有幾個地方我弄錯了，所以重新提問一遍，麻煩大家幫我想一想!!
程式碼
  1. Sub morecriteriafilter()
  2.    
  3.     Dim i As Integer, j As Integer, k As Integer
  4.    
  5.     With Worksheets("be1")
  6.     x = 0
  7.         For i = 0 To 5
  8.             For j = 0 To 5
  9.                     .Range("A1").AutoFilter Field:=2, Criteria1:="<" & 3 + i, Operator:=xlAnd, Criteria2:=">" & 0 + i
  10.                     .Range("A1").AutoFilter Field:=3, Criteria1:="=" & 1 + x
  11.                     .Range("A1").AutoFilter Field:=5, Criteria1:=Cells(j + 2, 10)
  12.                     .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Worksheets("1").Range("B2").Offset(7 * i, 7 * j)
  13.                     
  14.             Next j
  15.         Next i
  16.     .Range("A1").AutoFilter
  17.     End With
  18.    
  19. End Sub
複製代碼
變數範圍
t0 (field:=2) : 1~1065
T (field:=3) : 1~121
K (field:=5) : Cells(2~132,10)
問題如下
目前程式碼假定T=1(即x=0)，我設定了i和j來表示變數t0、K不同時，會在工作表"1"中不同位置顯示
Q1:   但是我現在想加了一個for x=0 to 120來表示變數T不同時的迴圈，並顯示在額外增加(本來沒有)的工作表"2"、"3"、...、"120"、"121"中，但是.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Worksheets("1").Range("B2").Offset(7 * i, 7 * j)中的Worksheets("1")不知道要如何改?
Q2:  我提供的程式碼只顯示i =0 to 5 及j= 0 to 5，但是我要的是i=0 to 1063，j=0 to 130，可是會當機，想請問如何改動?
收藏 分享

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2016-5-10 22:27 | 只看該作者
本帖最後由 luhpro 於 2016-5-10 22:32 編輯

回復 1# 被論文逼瘋的人
Q1:

Worksheets("1") => Sheets(x + 1 & "")


Q2:
試試這樣是否可以: (未考慮效率改善, 僅針對當機情形處理)
  1. Sub morecriteriafilter()
  2.    
  3.     Dim i As Integer, j As Integer, k As Integer
  4.    
  5.     With Worksheets("be1")
  6.     x = 0
  7.         Application.ScreenUpdating = False
  8.         For i = 0 To 5
  9.             For j = 0 To 5
  10.                     .Range("A1").AutoFilter Field:=2, Criteria1:="<" & 3 + i, Operator:=xlAnd, Criteria2:=">" & 0 + i
  11.                     DoEvents
  12.                     .Range("A1").AutoFilter Field:=3, Criteria1:="=" & 1 + x
  13.                     DoEvents
  14.                     .Range("A1").AutoFilter Field:=5, Criteria1:=Cells(j + 2, 10)
  15.                     DoEvents
  16.                     .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Worksheets("1").Range("B2").Offset(7 * i, 7 * j)
  17.                     DoEvents
  18.             Next j
  19.         Next i
  20.     .Range("A1").AutoFilter
  21.     DoEvents
  22.     Application.ScreenUpdating = True
  23.     End With
  24. End Sub
複製代碼

TOP

被論文逼瘋的人

帖子
9 
主題
4 
精華
0 
積分
15 
點名
0  
作業系統
windows 10 
軟體版本
office 2010 
閱讀權限
10 
性別
女 
來自
桃園 
註冊時間
2016-5-4 
最後登錄
2016-6-8 
3#
發表於 2016-5-13 12:04 | 只看該作者
回復 2# luhpro
午安~~
很感謝您的幫助!!!
我嘗試用了您提供的兩個方法
做了一些更動
就成功了!!!
以下是程式碼:：
  1. Sub test()
  2.    
  3.     Dim i As Integer, j As Integer, x As Integer
  4.    
  5.     With Worksheets("test")
  6.     Application.ScreenUpdating = False
  7.     For x = 2 To 48
  8.         For i = 0 To 1063
  9.             For j = 0 To 142
  10.                     .Range("A1").AutoFilter Field:=2, Criteria1:="<" & 3 + i, Operator:=xlAnd, Criteria2:=">" & 0 + i
  11.                     DoEvents
  12.                     .Range("A1").AutoFilter Field:=3, Criteria1:=Cells(x, 11)
  13.                     DoEvents
  14.                     .Range("A1").AutoFilter Field:=5, Criteria1:=Cells(j + 2, 10)
  15.                     DoEvents
  16.                     .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets(x).Cells(2, 2).Offset(7 * i, 7 * j)
  17.                         '解釋-----.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy後面放的sheets(x)，
  18.                         '發現()內不能寫成x+1算式，會跑出同sheets(1)的值(此時x默認為0,就算我先設x=2也一樣)；
  19.                         '使用sheets(x)時，如果有事先設置x=2,就會跑出sheets(2)的值，所以我就用這個。
  20.                     DoEvents
  21.             Next j
  22.         Next i
  23.     Next x
  24.     .Range("A1").AutoFilter
  25.     Application.ScreenUpdating = True
  26.     '使用doevents和application.screenupdating後我發現整體效率會下降，但是真的能改善當機問題
  27.    
  28.     End With
  29.    
  30. End Sub
複製代碼
Thank you very much^  ^

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
4#
發表於 2016-5-13 22:13 | 只看該作者
本帖最後由 luhpro 於 2016-5-13 22:19 編輯
回復  luhpro
...
'解釋-----.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy後面放的sheets(x)，
'發現()內不能寫成x+1算式，會跑出同sheets(1)的值(此時x默認為0,就算我先設x=2也一樣)；
'使用sheets(x)時，如果有事先設置x=2,就會跑出sheets(2)的值，所以我就用這個。 ...
被論文逼瘋的人 發表於 2016-5-13 12:04


以下敘述中皆假設 x = 2
Sheets(x + 1)=Sheets(3) <> Sheets("3")
前面 Sheets(3) 的 3 是 Index 編號 (等同在 VBAProject 專案總管 列表中 Sheet1(S1) 前面那個 Sheet1<CodeName> 的 1 )
後面 Sheets("3") 的 3 是 Sheet 的 名稱(等同在 VBAProject 專案總管 列表中 Sheet1(S1) 後面括號中間的 S1<SheetName> )
除非你從建立檔案開始後就一直照順序產生 Sheets("1"),Sheets("2")...
且沒做任何工作表的增刪,移動或更名,
否則 Sheets(100) 很難 索引到 Sheets("100").

你的情形中若 Sheets(x + 1 & "") 不能正確索引到 Sheets("3") 的話,
改成 Sheets((x + 1) & "") 試試. (後面加上 & "" 是強制將 X+1 的結果改成字串, 等同 "3")

以上是我的理解,若有錯誤歡迎指正.

TOP

被論文逼瘋的人

帖子
9 
主題
4 
精華
0 
積分
15 
點名
0  
作業系統
windows 10 
軟體版本
office 2010 
閱讀權限
10 
性別
女 
來自
桃園 
註冊時間
2016-5-4 
最後登錄
2016-6-8 
5#
發表於 2016-5-29 00:43 | 只看該作者
回復 4# luhpro

嗯 我試了你提供的Sheets((x + 1) & "")， x值終於會跟著所設定的值跑了!!
我之前的作法其實是
1 事先在最前面開一張工作表，
2 將會使用到的工作表的名稱列在A欄
3 然後用網路上找到的程式碼
  1. Sub AddSheet()
  2.    Dim i As Integer
  3.     For i = 1 To 76
  4.         Sheets.Add after:=Sheets(Sheets.Count)
  5.         Sheets(Sheets.Count).Name = Sheets(1).Range("A" & i)
  6.     Next
  7. End Sub
複製代碼
跑出所有的我預定要得到的工作表之後，
4 刪掉含有工作表名稱的工作表，
5 再進行篩選
PS 就是需要分兩個步驟，不過addsheet()所需的時間短不太影響整體就是了

感謝幫助!!!

TOP

        靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。
返回列表 上一主題