|
- Sub 提取信息()
- Dim t#
- t = Timer
- Application.ScreenUpdating = False
- Dim i, sh, num1, k
- a = MsgBox("将删除所有学生信息," & vbCrLf & "按“是”继续执行," & vbCrLf & "按“否”则退出。", 308, "提示")
- If a = vbNo Then Exit Sub
- With Sheet16
- sh = .Cells(Rows.Count, "b").End(xlUp).Row
- If sh > 5 Then .Range("B6" & ":L" & sh).ClearContents
- End With
- num1 = Sheet1.Range("C65536").End(xlUp).Row()
- If num1 < 7 Then Exit Sub
- arr = Sheet1.Range("a7:ai" & num1)
- Dim result(), lCount&
- ReDim result(1 To UBound(arr), 1 To 12)
- For i = LBound(arr) To UBound(arr)
- If arr(i, 35) >= 1 And arr(i, 35) < 4 And arr(i, 30) >= 6 And arr(i, 30) < 16 Then
- lCount = lCount + 1
- result(lCount, 2) = arr(i, 3)
- result(lCount, 3) = arr(i, 4)
- result(lCount, 4) = arr(i, 5)
- result(lCount, 5) = arr(i, 6)
- result(lCount, 6) = arr(i, 7)
- result(lCount, 9) = arr(i, 28)
- result(lCount, 12) = arr(i, 30)
- End If
- Next i
- With Sheet16
- If lCount > 0 Then
- .Range("a6").Resize(lCount, UBound(result, 2)) = result
- .Range("D6:D" & 5 + lCount).NumberFormatLocal = "yy-mm"
- .Range("B6" & ":L" & 5 + lCount).Sort Key1:=.Range("L6")
- Else
- MsgBox "没有三类残学生信息。", 308, "提示"
- End If
- End With
- Application.ScreenUpdating = True
- MsgBox Timer - t
- End Sub
复制代码 |
|