|
Sub 填写志愿()
Dim ar, br(), i, r, m
Sheet3.[A3:D65536] = Empty
With Sheet2
r = .Cells(.Rows.Count, 1).End(xlUp).Row
ar = .Range("A3").Resize(r - 2, 5)
End With
Call dsort(ar, 5)
ReDim br(1 To UBound(ar) * 2, 1 To 4)
For i = 1 To UBound(ar)
m = m + 1
br(m, 1) = "志愿" & i & "专业代码及名称:"
br(m, 2) = ar(i, 3) & ar(i, 4)
br(m, 3) = "高校代码及名称:"
br(m, 4) = ar(i, 1) & ar(i, 2)
m = m + 1
br(m, 1) = "'" & ar(i, 3)
br(m, 2) = ar(i, 4)
br(m, 3) = ar(i, 1)
br(m, 4) = ar(i, 2)
Next
Sheet3.[A3].Resize(m, 4) = br
End Sub |
|