Hsieh

回復 1# lifedidi
表單模組

1. Private Sub UserForm_Initialize()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With Sheet1
   
4.    For Each a In .Range(.[A1], .[A1].End(xlDown))
   
5.    d(a.Value) = ""
   
6.    Next
   
7. End With
   
8. ComboBox1.List = d.keys
   
9. End Sub

複製代碼

Hsieh

回復 3# lifedidi

Sheet2模組

1. Private Sub CommandButton1_Click()
   
2.    FormA.Show 0
   
3. End Sub

複製代碼

FormA模組

1. Private Sub CommandButton1_Click()
   
2. FormB.Show 0
   
3. End Sub
   
4. 
   
5. Private Sub UserForm_Initialize()
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. With Sheet1
   
8.    For Each a In .Range(.[A2], .[A1].End(xlDown))
   
9.    d(a.Value) = ""
   
10.    Next
    
11. End With
    
12. ComboBox1.List = d.keys
    
13. End Sub

複製代碼

FormB模組

1. Private Sub CommandButton1_Click()
   
2. FormC.Show 0
   
3. FormC.計算 1
   
4. End Sub
   
5. 
   
6. Private Sub CommandButton2_Click()
   
7. FormC.Show 0
   
8. FormC.計算 2
   
9. End Sub

複製代碼

FormC模組

1. Sub 計算(work As Integer)
   
2. Dim Ar()
   
3. With Sheet1
   
4.    For Each a In .Range(.[A2], .[A1].End(xlDown))
   
5.       If a.Value = FormA.ComboBox1.Value Then
   
6.          ReDim Preserve Ar(s)
   
7.          Ar(s) = a.Offset(, 1).Value
   
8.          s = s + 1
   
9.       End If
   
10.    Next
    
11. End With
    
12. If work = 1 Then ListBox1.AddItem Format(Application.Sum(Ar), "hh:mm:ss")
    
13. If work = 2 Then ListBox1.AddItem Format(Application.Average(Ar), "hh:mm:ss")
    
14. End Sub

複製代碼

Form Test.zip (12.55 KB)

下載次數: 23

2013-2-26 14:18

Hsieh

回復 5# lifedidi
你是要在LISTBOX內顯示或是儲存格內顯示?
LISTBOX內要顯示超過24小時加總時間

1. Sub 計算(work As Integer)
   
2. Dim Ar()
   
3. With Sheet1
   
4.    For Each a In .Range(.[A2], .[A1].End(xlDown))
   
5.       If a.Value = FormA.ComboBox1.Value Then
   
6.          ReDim Preserve Ar(s)
   
7.          Ar(s) = a.Offset(, 1).Value
   
8.          s = s + 1
   
9.       End If
   
10.    Next
    
11. End With
    
12. If work = 1 Then ListBox1.AddItem Application.Text(Application.Sum(Ar), "[hh]:mm:ss")
    
13. If work = 2 Then ListBox1.AddItem Application.Text(Application.Average(Ar), "[hh]:mm:ss")
    
14. End Sub

複製代碼

若儲存格格式則自訂為[hh]:mm

Hsieh

回復 7# lifedidi
首先先把所有Form.Show的參數加上0
Form.Show 0
讓開啟的表單都為非強制回應

1. Sub 計算(work As Integer)
   
2. Dim Ar(), Ay()
   
3. With Sheet1
   
4.    For Each a In .Range(.[D7], .[D7].End(xlDown))  '在D欄的資料循環
   
5.       If a.Value = 專案編號.ComboBox1.Value Then   '如果D欄的值等於下拉選單的值
   
6.          ReDim Preserve Ar(s)  '保留陣列元素並重設陣列上限
   
7.          ReDim Preserve Ay(s)
   
8.          Ar(s) = a.Offset(, 17).Value  '將D欄向右17欄的值寫入陣列
   
9.          Ay(s) = a.Offset(, -3).Resize(, 26).Value  '將A:Z欄的值寫入陣列
   
10.          s = s + 1  '預備下次陣列擴展的上限
    
11.       End If
    
12.    Next
    
13. End With
    
14. If s > 0 Then  '如果有符合的資料
    
15. Sheet2.Range("C5").CurrentRegion.Offset(2) = ""   '先清空上次的查詢內容
    
16. Sheet2.[C7].Resize(s, 26) = Application.Transpose(Application.Transpose(Ay))   '寫入工作表
    
17. If work = 1 Then ListBox1.AddItem Application.Text(Application.Sum(Ar), "[hh]:mm:ss")  '文字方塊顯示加總結果
    
18. If work = 2 Then ListBox1.AddItem Application.Text(Application.Average(Ar), "[hh]:mm:ss")  '文字方塊顯示平均結果
    
19. End If
    
20. End Sub

複製代碼

Hsieh

回復 10# lifedidi
不是很清楚你要甚麼，試試看附件流程看是否符合需求

工時系統excel版本).rar (51.31 KB)

下載次數: 13

2013-2-27 23:24