|
|
- Sub test2() '
-
- Dim ar(), br, cr, Dict As Object, strKey As String
- Dim i As Long, j As Long, pos As Long, idx
-
- 'Application.ScreenUpdating = False
-
- Set Dict = CreateObject("Scripting.Dictionary")
- br = Sheet1.Range("A1").CurrentRegion
- For i = 2 To UBound(br) Step 5
- strKey = Asc(Left(br(i, 1), 1)) - 64 & "节"
- For j = 3 To UBound(br, 2)
- Dict.Add strKey & br(i, j) & br(i + 2, j), Array(i, j)
- Next
- Next
-
- cr = Sheet2.Range("A1").CurrentRegion.Offset(, 3).Resize(, 3).Value
- ReDim ar(1 To UBound(cr), 1 To UBound(cr, 2) * 4)
- For i = 1 To UBound(ar, 2) Step 4
- For j = 0 To 3
- ar(1, i + j) = Split("课程 课组 教师 教室")(j)
- Next
- Next
-
- For j = 1 To UBound(cr, 2)
- For i = 2 To UBound(cr)
- If Dict.Exists(cr(i, j)) Then
- pos = Val(cr(i, j)) * 4 - 4
- idx = Dict(cr(i, j))
- ar(i, pos + 1) = br(idx(0) + 2, idx(1))
- ar(i, pos + 2) = br(idx(0), 1)
- ar(i, pos + 3) = br(idx(0) + 3, idx(1))
- ar(i, pos + 4) = Left(br(idx(0) + 1, idx(1)), 3)
- End If
- Next
- Next
-
- With Sheet2.Range("I1")
- .CurrentRegion.Clear
- With .Resize(UBound(ar), UBound(ar, 2))
- .Borders.Weight = xlHairline
- .HorizontalAlignment = xlCenter
- .Columns(1).NumberFormatLocal = "@"
- .Rows(1).Font.Bold = True
- .Value = ar
- End With
- End With
-
- Set Dict = Nothing
- Application.ScreenUpdating = True
- Beep
- End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-2-15 11:53
楼主