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

yanto913

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

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

Hsieh

回復 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

複製代碼

yanto913

謝謝版主大人，剛好可以利用颱風天鑽研一下VBA，因為功力不夠之前大部分都是用錄製的方法
，還好有版主幫忙，不然這次我真的寫不出來捏!!之後會好好瞭解裏面的涵義的，謝謝。

yanto913

現在遇到了一個問題耶，如果我的實際讀書時間是在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

yanto913

我弄好了，原來是要貼在來源那邊，然後我把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]也都要多一個小點. 呢？？這我就不知道了

Hsieh

回復 5# yanto913
請參閱VBA說明檔
With 陳述式可讓您對某個物件執行一系列的陳述式，而不用重複指出物件的名稱，例如，要改變一個物件的多個屬性，可以在 With 控制權結構中加上指定屬性的陳述式，這時後只要再第一行指名物件名稱，而之後的指定屬性陳述式中就不用再加上物件名稱。

yanto913

謝謝版主，我瞭解了，這個程式對我非常有幫助，我也正在學習VBA語法，希望以後能像版主用少少幾行就能達到效果的功力    謝謝

yagami12th

想請教一下，下面這行程式碼一直看不懂，能麻煩大大解析嗎？先謝謝了

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

GBKEE

回復 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 為數字

yagami12th

謊謝GBKEE大詳解，原來offset可以不設定列，因為我之前看書都打a.offset(0,4)，學到了，謝謝。

a.Offset(, 4)