|
- Sub test2()
- Dim r%, i%
- Dim arr, brr, zrr()
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- lk = [{7.13,14,14,3.63}]
- With Worksheets("考场安排")
- r = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("a2:f" & r)
- End With
- xm = ""
- For i = 1 To UBound(arr)
- If arr(i, 5) <> xm Then
- m = m + 1
- ReDim Preserve zrr(1 To 2, 1 To m)
- zrr(1, m) = i
- zrr(2, m) = i
- xm = arr(i, 5)
- Else
- zrr(2, m) = i
- End If
- Next
- With Worksheets("座位贴")
- .Cells.Clear
- For k = 1 To UBound(zrr, 2) Step 2
- m0 = Application.Max(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(.Rows.Count, 6).End(xlUp).Row)
- If m0 > 1 Then
- m0 = m0 + 1
- End If
- hs = 0
- For j = 1 To IIf(k + 1 <= UBound(zrr, 2), 2, 1)
- If zrr(2, k + j - 1) - zrr(1, k + j - 1) + 1 > hs Then
- hs = zrr(2, k + j - 1) - zrr(1, k + j - 1) + 1
- End If
- m = m0
- n = j * 5 - 4
- With .Cells(m, n)
- .Value = arr(zrr(1, k + j - 1), 5) & "班教室"
- .Resize(1, 4).Merge
- With .Font
- .Name = "等线"
- .Size = 18
- .Bold = True
- End With
- End With
- For i = zrr(1, k + j - 1) To zrr(2, k + j - 1)
- m = m + 1
- .Cells(m, n) = arr(i, 2)
- .Cells(m, n + 1) = arr(i, 3)
- .Cells(m, n + 2) = arr(i, 1)
- .Cells(m, n + 3) = arr(i, 4)
- Next
- With .Cells(m0 + 1, n).Resize(zrr(2, k + j - 1) - zrr(1, k + j - 1) + 1, 4)
- .Borders.LineStyle = xlContinuous
- With .Font
- .Name = "等线"
- .Bold = True
- End With
- End With
- With .Cells(m0 + 1, n).Resize(zrr(2, k + j - 1) - zrr(1, k + j - 1) + 1, 1)
- .NumberFormatLocal = "000"
- With .Font
- .Size = 18
- End With
- End With
- With .Cells(m0 + 1, n + 1).Resize(zrr(2, k + j - 1) - zrr(1, k + j - 1) + 1, 2)
- With .Font
- .Size = 20
- End With
- End With
- With .Cells(m0 + 1, n + 3).Resize(zrr(2, k + j - 1) - zrr(1, k + j - 1) + 1, 1)
- .Orientation = xlVertical
- .ShrinkToFit = True
- With .Font
- .Size = 8
- End With
- End With
- Next
- .Rows(m0).RowHeight = 23.25
- .Rows(m0 + 1).Resize(hs).RowHeight = 52.5
- Next
- For j = 1 To UBound(lk)
- .Columns(j).ColumnWidth = lk(j)
- .Columns(j + 5).ColumnWidth = lk(j)
- Next
- .Columns(5).ColumnWidth = 3.38
- With .UsedRange
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- End With
- End With
- End Sub
复制代码 |
|