[已解决]求助：如何根据生成试室座位号窗口的复选框打钩和输入的人数生成到D列和E列

qinhuan66

求助：如何根据生成试室座位号窗口的复选框打钩和输入的人数生成到D列和E列，例如  图1  和 图2  的对比。

意思是假如在第四试室打钩输入10的话在D列和E列也按上述出现 。谢谢

生成试室座位.rar (11.71 KB, 下载次数: 8)

2013-6-11 18:05 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-11 18:53

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, arrTemp()
   
3.     Dim i As Long, j As Long
   
4.     Dim lLastRow As Long
   
5.    
   
6.     arr = CheckInput
   
7.     If Not IsArray(arr) Then Exit Sub
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.     Application.EnableEvents = False
    
11.     Columns("d:e").ClearContents
    
12.     Range("d2").Resize(, 2) = Array("试室号", "座位号")
    
13.    
    
14.     For i = 1 To UBound(arr)
    
15.         If Len(arr(i, 1)) Then
    
16.             lLastRow = Cells(Rows.Count, "d").End(xlUp).Row + 1
    
17.             ReDim arrTemp(1 To arr(i, 2), 1 To 2)
    
18.             For j = 1 To arr(i, 2)
    
19.                 arrTemp(j, 1) = Format(Val(arr(i, 1)), "'00")
    
20.                 arrTemp(j, 2) = Format(j, "'00")
    
21.             Next
    
22.             Cells(lLastRow, "d").Resize(arr(i, 2), 2).Value = arrTemp
    
23.         End If
    
24.     Next
    
25.     Application.ScreenUpdating = True
    
26.     Application.DisplayAlerts = True
    
27.     Application.EnableEvents = True
    
28. End Sub
    
29. 
    
30. Private Sub CommandButton3_Click()
    
31.     End
    
32. End Sub
    
33. 
    
34. Function CheckInput()
    
35.     Dim objControl As Control
    
36.     Dim str$
    
37.     Dim strTemp
    
38.     Dim arr(), i As Byte
    
39.     ReDim arr(1 To 30, 1 To 2)
    
40.     For Each objControl In Me.Controls
    
41. 
    
42.         If TypeName(objControl) Like "CheckBox" Then
    
43.             With objControl
    
44.                 If .Value Then
    
45.                 strTemp = Me.Controls(Replace(.Name, "CheckBox", "TextBox")).Text
    
46.                     If Not IsNumeric(strTemp) Or strTemp Like "*[.-]*" Then
    
47.                         str = str & .Name & " 后面的文本框输入的是整数值" & vbCrLf
    
48.                     Else
    
49.                        i = i + 1
    
50.                        arr(i, 1) = Mid(.Name, 9)
    
51.                        arr(i, 2) = Val(strTemp)
    
52.                     End If
    
53.                 End If
    
54.             End With
    
55.         End If
    
56.     Next
    
57.     CheckInput = Not Len(str) > 0
    
58.     If Not CheckInput Then
    
59.         MsgBox str
    
60.     Else
    
61.         CheckInput = arr
    
62.     End If
    
63. End Function

复制代码

跳转到最佳答案楼层

qinhuan66

=IF(OR(A3=""),"",TEXT(COUNTIF(E$3:E3,"01"),"00"))
现在我是上条函数生成的
即是在E列输入座位号在D列自动产生试室（在A列有姓名的情况下),A列没姓名为空D列为空

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, arrTemp()
   
3.     Dim i As Long, j As Long
   
4.     Dim lLastRow As Long
   
5.    
   
6.     arr = CheckInput
   
7.     If Not IsArray(arr) Then Exit Sub
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.     Application.EnableEvents = False
    
11.     Columns("d:e").ClearContents
    
12.     Range("d2").Resize(, 2) = Array("试室号", "座位号")
    
13.    
    
14.     For i = 1 To UBound(arr)
    
15.         If Len(arr(i, 1)) Then
    
16.             lLastRow = Cells(Rows.Count, "d").End(xlUp).Row + 1
    
17.             ReDim arrTemp(1 To arr(i, 2), 1 To 2)
    
18.             For j = 1 To arr(i, 2)
    
19.                 arrTemp(j, 1) = Format(Val(arr(i, 1)), "'00")
    
20.                 arrTemp(j, 2) = Format(j, "'00")
    
21.             Next
    
22.             Cells(lLastRow, "d").Resize(arr(i, 2), 2).Value = arrTemp
    
23.         End If
    
24.     Next
    
25.     Application.ScreenUpdating = True
    
26.     Application.DisplayAlerts = True
    
27.     Application.EnableEvents = True
    
28. End Sub
    
29. 
    
30. Private Sub CommandButton3_Click()
    
31.     End
    
32. End Sub
    
33. 
    
34. Function CheckInput()
    
35.     Dim objControl As Control
    
36.     Dim str$
    
37.     Dim strTemp
    
38.     Dim arr(), i As Byte
    
39.     ReDim arr(1 To 30, 1 To 2)
    
40.     For Each objControl In Me.Controls
    
41. 
    
42.         If TypeName(objControl) Like "CheckBox" Then
    
43.             With objControl
    
44.                 If .Value Then
    
45.                 strTemp = Me.Controls(Replace(.Name, "CheckBox", "TextBox")).Text
    
46.                     If Not IsNumeric(strTemp) Or strTemp Like "*[.-]*" Then
    
47.                         str = str & .Name & " 后面的文本框输入的是整数值" & vbCrLf
    
48.                     Else
    
49.                        i = i + 1
    
50.                        arr(i, 1) = Mid(.Name, 9)
    
51.                        arr(i, 2) = Val(strTemp)
    
52.                     End If
    
53.                 End If
    
54.             End With
    
55.         End If
    
56.     Next
    
57.     CheckInput = Not Len(str) > 0
    
58.     If Not CheckInput Then
    
59.         MsgBox str
    
60.     Else
    
61.         CheckInput = arr
    
62.     End If
    
63. End Function

复制代码

hwc2ycy

清空按钮你自己写，我这只写了生成的代码。

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, arrTemp()
   
3.     Dim i As Long, j As Long
   
4.     Dim lLastRow As Long
   
5.    
   
6.     arr = CheckInput
   
7.     If Not IsArray(arr) Then Exit Sub
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.     Application.EnableEvents = False
    
11.     Columns("d:e").ClearContents
    
12.     Range("d2").Resize(, 2) = Array("试室号", "座位号")
    
13.    
    
14.     For i = 1 To UBound(arr)
    
15.         If Len(arr(i, 1)) Then
    
16.             lLastRow = Cells(Rows.Count, "d").End(xlUp).Row + 1
    
17.             ReDim arrTemp(1 To arr(i, 2), 1 To 2)
    
18.             For j = 1 To arr(i, 2)
    
19.                 arrTemp(j, 1) = Format(Val(arr(i, 1)), "'00")
    
20.                 arrTemp(j, 2) = Format(j, "'00")
    
21.             Next
    
22.             Cells(lLastRow, "d").Resize(arr(i, 2), 2).Value = arrTemp
    
23.         Else
    
24.             Exit For
    
25.         End If
    
26.     Next
    
27.     Application.ScreenUpdating = True
    
28.     Application.DisplayAlerts = True
    
29.     Application.EnableEvents = True
    
30. End Sub

复制代码

第一个过程改下，可以少跑些循环，时间不过也没有多少。

hwc2ycy

str = str & .Name & " 后面的文本框输入的是整数值" & vbCrLf

这里写错提示了，非大于0的整数值。

qinhuan66

hwc2ycy 发表于 2013-6-11 19:03
第一个过程改下，可以少跑些循环，时间不过也没有多少。

求助能否修改一下代码加多在F列提取K列的数全在一起生成。谢谢

生成试室座位.rar (23.82 KB, 下载次数: 8)

2013-6-11 20:55 上传

点击文件名下载附件