返回列表 上一主題 發帖

[發問] 請問如何用VBA達到多重篩選，以及篩選後依序填入??

yanto913

帖子
116 
主題
29 
精華
0 
積分
232 
點名
0  
作業系統
winXp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
來自
台灣台中市 
註冊時間
2010-9-6 
最後登錄
2023-7-11 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2010-9-19 01:18 | 只看該作者

[發問] 請問如何用VBA達到多重篩選，以及篩選後依序填入??

1.判斷原則為:當某人(王小明)目前國文科目總共花了300分鐘，那麼計劃表中就顯示在『實際花費時間』中的第二進度(國文)180，剩餘的120歸到第五進度(國文)中，也就是一直歸類到實際花費時間小於預計花費時間，或在下一欄位已經沒有此科目讀書計畫進度才容許實際花費時間大於預計花費時間(以歷史為例，意思也就是歸到沒有辦法再往下歸才把所花費時間填入最後的讀書進度)                                       
2.如果用函數是可以辦到上述所講的，但是每個人讀書計畫都不一樣以及每天讀書計畫也會有變動，當學生多就要花費更多時間；以及每天計畫都不一樣，導致每天都要重做一次，所以才想說有沒有可以用VBA的方式篩選學生與科目後，再利用判斷預計時間與實際時間的大小做往下填入的動作，而當判斷到下一欄位已經沒有此科目後，即使實際時間比預計時間大才可填入       

請參考一下我所希望達到目的的檔案，這樣各位前輩們也比較了解
https://sites.google.com/site/yanto913/data/Plan.xls
請各位前輩們幫一下忙，謝謝^^
收藏 分享
YOYO

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
10#
發表於 2012-1-4 21:22 | 只看該作者
謊謝GBKEE大詳解，原來offset可以不設定列，因為我之前看書都打a.offset(0,4)，學到了，謝謝。

a.Offset(, 4)

TOP

GBKEE

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

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

回復 8# yagami12th
mytime = Application.Min(a.Offset(, 4), dic(a & a.Offset(, 1)))
Application.Min:  使用工作表函數Min
Offset 屬性。 傳回 Range 物件，用以代表某個指定區域以外的範圍 唯讀。
a.Offset(, 4)     同一列,右移4欄的範圍
a.Offset(2, 4)  下移2列,右移4欄的範圍
dic 程序設為字典物件   a & a.Offset(, 1) ->字串
dic(a & a.Offset(, 1)) 在程序的 Item 為數字

TOP

yagami12th

帖子
88 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE2010 
閱讀權限
20 
性別
男 
註冊時間
2012-1-3 
最後登錄
2017-12-31 
8#
發表於 2012-1-4 20:56 | 只看該作者
想請教一下，下面這行程式碼一直看不懂，能麻煩大大解析嗎？先謝謝了

mytime = Application.Min(a.Offset(, 4), dic(a & a.Offset(, 1)))

TOP

yanto913

帖子
116 
主題
29 
精華
0 
積分
232 
點名
0  
作業系統
winXp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
來自
台灣台中市 
註冊時間
2010-9-6 
最後登錄
2023-7-11 
7#
發表於 2010-9-20 09:54 | 只看該作者
謝謝版主，我瞭解了，這個程式對我非常有幫助，我也正在學習VBA語法，希望以後能像版主用少少幾行就能達到效果的功力    謝謝
YOYO

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2010-9-19 23:59 | 只看該作者
回復 5# yanto913
請參閱VBA說明檔
With 陳述式可讓您對某個物件執行一系列的陳述式，而不用重複指出物件的名稱，例如，要改變一個物件的多個屬性，可以在 With 控制權結構中加上指定屬性的陳述式，這時後只要再第一行指名物件名稱，而之後的指定屬性陳述式中就不用再加上物件名稱。
學海無涯_不恥下問

TOP

yanto913

帖子
116 
主題
29 
精華
0 
積分
232 
點名
0  
作業系統
winXp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
來自
台灣台中市 
註冊時間
2010-9-6 
最後登錄
2023-7-11 
5#
發表於 2010-9-19 23:18 | 只看該作者
我弄好了，原來是要貼在來源那邊，然後我把With Sheet3拿掉了
Sub Ex()
Set dic = CreateObject("Scripting.Dictionary")
Set dicn = CreateObject("Scripting.Dictionary")
For Each a In Sheets("sheet3").Range([H2], [H65536].End(xlUp))
   dic(a & a.Offset(, 1)) = dic(a & a.Offset(, 1)) + a.Offset(, 2)
Next
For Each a In Sheets("sheet1").Range(Sheets("sheet1").[A2], Sheets("sheet1").[A65536].End(xlUp))
   dicn(a & a.Offset(, 1)) = dicn(a & a.Offset(, 1)) + 1
Next
For Each a In Sheets("sheet1").Range(Sheets("sheet1").[A2], Sheets("sheet1").[A65536].End(xlUp))
    If a <> "" Then
    mytime = Application.Min(a.Offset(, 4), dic(a & a.Offset(, 1)))
    If dicn(a & a.Offset(, 1)) = 1 Then
       a.Offset(, 5) = Val(dic(a & a.Offset(, 1)))
       Else
       a.Offset(, 5) = mytime
       dicn(a & a.Offset(, 1)) = dicn(a & a.Offset(, 1)) - 1
       dic(a & a.Offset(, 1)) = dic(a & a.Offset(, 1)) - mytime
    End If
    End If
Next
End Sub

剛剛上網查了一下用With Sheet3可以取代Sheets("sheet3")
也就是程式由Sheets("sheet3").Range([H2], [H65536].End(xlUp))
變成.Range(.[H2], .[H65536].End(xlUp))
不知道為什麼.[H2], .[H65536]也都要多一個小點. 呢？？這我就不知道了
YOYO

TOP

yanto913

帖子
116 
主題
29 
精華
0 
積分
232 
點名
0  
作業系統
winXp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
來自
台灣台中市 
註冊時間
2010-9-6 
最後登錄
2023-7-11 
4#
發表於 2010-9-19 21:08 | 只看該作者
現在遇到了一個問題耶，如果我的實際讀書時間是在sheet3，改成下列就出現錯誤了！！
For Each a In .Sheets("sheet3").Range(.[H2], .[H65536].End(xlUp))
彈出→視窗說找不到方法或資料成員
若改成下列
For Each a In Sheets("sheet3").Range(.[H2], .[H65536].End(xlUp))
彈出→物件或應用程式定義上的錯誤
https://sites.google.com/site/yanto913/data/Plan2.xls
YOYO

TOP

yanto913

帖子
116 
主題
29 
精華
0 
積分
232 
點名
0  
作業系統
winXp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
來自
台灣台中市 
註冊時間
2010-9-6 
最後登錄
2023-7-11 
3#
發表於 2010-9-19 13:01 | 只看該作者
謝謝版主大人，剛好可以利用颱風天鑽研一下VBA，因為功力不夠之前大部分都是用錄製的方法
，還好有版主幫忙，不然這次我真的寫不出來捏!!之後會好好瞭解裏面的涵義的，謝謝。
YOYO

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2010-9-19 12:13 | 只看該作者
回復 1# yanto913
  1. Sub Ex()
  2. Set dic = CreateObject("Scripting.Dictionary")
  3. Set dicn = CreateObject("Scripting.Dictionary")
  4. With Sheet2
  5. For Each a In .Range(.[H2], .[H65536].End(xlUp))
  6.    dic(a & a.Offset(, 1)) = dic(a & a.Offset(, 1)) + a.Offset(, 2)
  7. Next
  8. For Each a In .Range(.[A2], .[A65536].End(xlUp))
  9.    dicn(a & a.Offset(, 1)) = dicn(a & a.Offset(, 1)) + 1
  10. Next
  11. For Each a In .Range(.[A2], .[A65536].End(xlUp))
  12.     If a <> "" Then
  13.     mytime = Application.Min(a.Offset(, 4), dic(a & a.Offset(, 1)))
  14.     If dicn(a & a.Offset(, 1)) = 1 Then
  15.        a.Offset(, 5) = Val(dic(a & a.Offset(, 1)))
  16.        Else
  17.        a.Offset(, 5) = mytime
  18.        dicn(a & a.Offset(, 1)) = dicn(a & a.Offset(, 1)) - 1
  19.        dic(a & a.Offset(, 1)) = dic(a & a.Offset(, 1)) - mytime
  20.     End If
  21.     End If
  22. Next
  23. End With
  24. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 道德是提昇自我的明燈，不該是呵斥別人的鞭子。
返回列表 上一主題