|
|
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
With ListBox1
For i = 0 To .ListCount - 1
n = 0
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
If .List(i, 0) <> "" Then
mc = .List(i, 0)
For s = 2 To UBound(ar)
If Trim(ar(s, 1)) = mc Then
n = n + 1
For j = 1 To UBound(ar, 2)
br(n, j) = ar(s, j)
Next j
End If
Next s
With Sheets("查询")
zf = .[s1] & .[s2] & "—" & .[t2] & .[s3] & .[s4] & "成绩统计表"
.[a1].CurrentRegion.Borders.LineStyle = 0
.[a1].CurrentRegion = Empty
.[a1] = zf
.[a2].Resize(1, UBound(ar, 2)) = ar
.[a3].Resize(n, UBound(br, 2)) = br
.[a2].Resize(n + 1, UBound(br, 2)).Borders.LineStyle = 1
.PrintOut
End With
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox "打印完毕！"
End Sub
Private Sub ListBox1_Click()
Dim br()
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
mc = .List(i, 0)
Exit For
End If
Next i
End With
If mc <> "" Then
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For s = 2 To UBound(ar)
If Trim(ar(s, 1)) = mc Then
n = n + 1
For j = 1 To UBound(ar, 2)
br(n, j) = ar(s, j)
Next j
End If
Next s
With Sheets("查询")
zf = .[s1] & .[s2] & "—" & .[t2] & .[s3] & .[s4] & "成绩统计表"
.[a1].CurrentRegion.Borders.LineStyle = 0
.[a1].CurrentRegion = Empty
.[a1] = zf
.[a2].Resize(1, UBound(ar, 2)) = ar
.[a3].Resize(n, UBound(br, 2)) = br
.[a2].Resize(n + 1, UBound(br, 2)).Borders.LineStyle = 1
End With
End If
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("全部")
ar = .[a1].CurrentRegion
End With
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) <> "" Then
d(Trim(ar(i, 1))) = ""
End If
Next i
Me.ListBox1.List = d.keys
End Sub
|
评分
-
1
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-3-24 16:16
楼主
