[已解决]请求各位大神帮完善下一个测试监控系统

z00128284

本人VBA不是太精通，请求各位大神帮完善下一个测试监控系统，谢谢，要求如下。当扫完条码后 对应条码开始计时 ，
经过设定的时间段后时间停止，并把对应条码的结束时间录入到表格结束时间栏，
对应条码表格颜色为红色，同时弹出提示框提示：哪个槽位的哪个条码已经测试OK.

最佳答案

月排行榜 / 总排行榜

wp8680

2015-7-21 08:55

1. Option Explicit
   
2. Public rgs As Range, i%
   
3. Sub 刷新()
   
4.     Dim rg As Range
   
5.     Set rg = Sheet1.Range("e" & Cells.Rows.Count).End(xlUp)
   
6.     If rg.Row < 3 Then End
   
7.     Set rgs = Sheet1.Range(Sheet1.Range("a3"), rg)
   
8.     i = rgs.Rows.Count
   
9.     时间
   
10. End Sub
    
11. 
    
12. Sub 时间()
    
13.     Dim t1 As Date
    
14.     Dim k%, kk%
    
15.     With rgs
    
16.         For k = 1 To i
    
17.             If .Cells(k, 3) = "" Then
    
18.                 kk = kk + 1
    
19.                 If .Cells(k, 2).Value + .Cells(k, 5).Value < Now Then
    
20.                     .Cells(k, 3).Value = Now
    
21.                 End If
    
22.             End If
    
23.         Next k
    
24.     End With
    
25.     If kk = 0 Then End
    
26.     DoEvents
    
27.     Application.OnTime Now() + TimeValue("00:00:01"), "时间"
    
28. End Sub

复制代码

在模块中加上主面语句后，并同时需要在Private Sub CommandButton1_Click()事件中也加入“CALL 刷新”语句。

跳转到最佳答案楼层

wp8680

1. Option Explicit
   
2. Public rgs As Range, i%
   
3. Sub 刷新()
   
4.     Dim rg As Range
   
5.     Set rg = Sheet1.Range("e" & Cells.Rows.Count).End(xlUp)
   
6.     If rg.Row < 3 Then End
   
7.     Set rgs = Sheet1.Range(Sheet1.Range("a3"), rg)
   
8.     i = rgs.Rows.Count
   
9.     时间
   
10. End Sub
    
11. 
    
12. Sub 时间()
    
13.     Dim t1 As Date
    
14.     Dim k%, kk%
    
15.     With rgs
    
16.         For k = 1 To i
    
17.             If .Cells(k, 3) = "" Then
    
18.                 kk = kk + 1
    
19.                 If .Cells(k, 2).Value + .Cells(k, 5).Value < Now Then
    
20.                     .Cells(k, 3).Value = Now
    
21.                 End If
    
22.             End If
    
23.         Next k
    
24.     End With
    
25.     If kk = 0 Then End
    
26.     DoEvents
    
27.     Application.OnTime Now() + TimeValue("00:00:01"), "时间"
    
28. End Sub

复制代码

在模块中加上主面语句后，并同时需要在Private Sub CommandButton1_Click()事件中也加入“CALL 刷新”语句。

z00128284

wp8680 发表于 2015-7-21 08:55
在模块中加上主面语句后，并同时需要在Private Sub CommandButton1_Click()事件中也加入“CALL 刷新”语句。 ...

大神，再请教一下，CommandButton1_Click()已经有下面一段代码了，那么call加在哪个地方合适呢？

Private Sub CommandButton1_Click()
    Dim a As String
    If ComboBox1.Text = "" Then
        MsgBox "请创建条码或者时间"
        Exit Sub
    Else
        a = TextBox1.Text
        If Len(a) = 0 Then
            Beep
            MsgBox "未扫描，请扫描！"
            TextBox1.SetFocus
        Else
            With Sheets("sheet1")
                .Range("A65536").End(xlUp).Offset(1, 0) = TextBox1.Text
                .Range("A65536").End(xlUp).Offset(0, 1) = Now
                .Range("A65536").End(xlUp).Offset(0, 4) = ComboBox1.Text
                .Range("A65536").End(xlUp).Offset(0, 3) = TextBox2.Text
                TextBox1 = ""
                TextBox1.SetFocus
                刷新
            End With
        End If
    End If
End Sub

z00128284

wp8680 发表于 2015-7-21 08:55
在模块中加上主面语句后，并同时需要在Private Sub CommandButton1_Click()事件中也加入“CALL 刷新”语句。 ...

大神这一项也帮实现下呢，谢谢。
同时弹出提示框提示：哪个槽位的哪个条码已经测试OK

wp8680

你没有看到？附件中已经帮你加了二个字，就是调用刷新这个宏代码。

wp8680

TextBox1 = ""
TextBox1.SetFocus
这二句下面有
刷新
这个词，你原代码是没有的。

z00128284

wp8680 发表于 2015-7-21 21:57
TextBox1 = ""
TextBox1.SetFocus
这二句下面有

大神这个功能可以一起实现么？ 我弄了好久都没有成功过。

到时间了对应条码表格颜色为红色，同时弹出提示框提示：哪个槽位的哪个条码已经测试OK.

wp8680

z00128284 发表于 2015-7-21 22:23
大神这个功能可以一起实现么？ 我弄了好久都没有成功过。

到时间了对应条码表格颜色为红色，同时弹出提 ...

可以啊，都能填写时间了，没有什么不可能的。

在时间代码中，加上这二句说行了。

只不过需要弹出提示后，及时确认，不然可能会影响下一条记录的判断（如果二项时间相距很远，则确定后无乎没有影响，只有当二项记录时间十分接近，才有可能延迟了下条记录的判断。

z00128284

wp8680 发表于 2015-7-22 12:18
可以啊，都能填写时间了，没有什么不可能的。

在时间代码中，加上这二句说行了。

大神，哪两句代码？回复中没有看到呢？

z00128284

wp8680 发表于 2015-7-22 12:18
可以啊，都能填写时间了，没有什么不可能的。

在时间代码中，加上这二句说行了。

那可不可以实现隔10分钟如果没有人为按确认，系统自动确认这项呢？ 不胜感激？谢谢。