|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
个人课表代码:
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim r%, i%
- Dim arr, brr
- If Target.Count > 1 Then
- Exit Sub
- End If
- If Target.Address = "$N$1" Then
- With Worksheets("机房课表")
- arr = .Range("b3:p30")
- ReDim brr(1 To 7, 1 To 10)
- m = 0
- For i = 1 To UBound(arr) Step 4
- m = m + 1
- n = -1
- For j = 1 To UBound(arr, 2) Step 3
- n = n + 2
- For k = 1 To 4
- If arr(i + k - 1, j + 1) = Target.Value Then
- brr(m, n) = arr(i + k - 1, j)
- brr(m, n + 1) = arr(i + k - 1, j + 2)
- End If
- Next
- Next
- Next
- End With
- With Worksheets("个人课表")
- .Range("b3").Resize(UBound(brr), UBound(brr, 2)) = brr
- End With
- End If
- End Sub
复制代码 |
|