核酸检测登记 VBA 窗体 求助 谢谢

shiruiqiang

281508269 发表于 2022-5-17 10:45
自己内部统计使用。需要提前发现。等码变色就晚了

那不如搞在线调查表，每天让职工填写。后台提取数据，比对职工名单
另：很多平台有批量证件号查询功能

281508269

1. Private Sub save()
   
2. 
   
3.     Dim erow&, i&
   
4.     Dim Arr0, brr
   
5.    
   
6.     With Worksheets("sheet1")
   
7.         If Worksheets("Sheet1").Rows.Hidden = True Then
   
8.             Worksheets("Sheet1").Rows.Hidden = False
   
9.         End If
   
10.     End With
    
11.       
    
12.     Worksheets("Sheet1").Select
    
13.         
    
14.     With Worksheets("Sheet1")
    
15.         If ComboBox1.Value = blank Then
    
16.             MsgBox "未选择人员"
    
17.         Exit Sub
    
18.         End If
    
19.         
    
20.         If DTPicker1.Value = blank Then
    
21.             MsgBox "未选择日期"
    
22.         Exit Sub
    
23.         End If
    
24.         
    
25.         erow = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' 取得最后一个非空单元格行数。为了不覆盖表头，+1去掉表头行
    
26.             If erow = 2 Then
    
27.                 Else
    
28.                 brr = .Range("A1:A" & erow - 1)
    
29.                     'Debug.Print brr
    
30.                 For i = 1 To UBound(brr)
    
31.                     If brr(i, 1) = TextBox1.Text Then
    
32.                         MsgBox (" 此日期的人员已经登记 ")
    
33.                     Exit Sub
    
34.                     End If
    
35.                 Next i
    
36.             End If
    
37.       
    
38.         .Cells(erow, "A").Value = ComboBox1.Value
    
39.         .Cells(erow, "B").Value = DTPicker1.Value
    
40.         Arr0 = .Range("C2:C" & erow)
    
41.     End With
    
42.      
    
43.      With Me.ListBox1
    
44.         .ColumnCount = 1
    
45.         .BackColor = &HFFFF00
    
46.         .ColumnWidths = "80"
    
47.         '.List = Arr0
    
48.      End With
    
49.      ComboBox1 = ""
    
50.      TextBox1.Text = ""
    
51.      TextBox2.Text = ""
    
52.      OptionButton1.Value = False
    
53.      OptionButton2.Value = False
    
54.      OptionButton3.Value = False
    
55.      OptionButton4.Value = False
    
56.     CreateList
    
57.     Worksheets("Manual").Select
    
58.     ThisWorkbook.save
    
59.    
    
60. 
    
61. End Sub
    
62. 
    
63. 
    
64. 
    
65. 
    

复制代码