|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub test()
Dim arr, brr(1 To 99999, 1 To 20), i%, m%, j%, tmp, l%, lr%
lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
arr = Sheet1.Range("a1:r" & lr)
For i = 1 To UBound(arr)
If Left(arr(i, 1), 1) = 1 Then
For j = 1 To 18
If arr(i + 1, j) <> "" Then
m = m + 1
brr(m, 1) = ""
brr(m, 2) = Trim(Mid(arr(i - 1, 1), InStr(arr(i - 1, 1), "姓名:") + 3, 4))
brr(m, 3) = DateSerial(Year(Date), Month(Date), j)
brr(m, 4) = Trim(Mid(arr(i - 1, 1), InStr(arr(i - 1, 1), "班次:") + 3))
brr(m, 5) = Format(brr(m, 3), "aaaa")
tmp = VBA.Split(arr(i + 1, j), " ")
For l = 0 To UBound(tmp) - 1
brr(m, 6 + l) = tmp(l)
Next
End If
Next
End If
Next
Sheet3.Rows("2:999").ClearContents
Sheet3.[a2].Resize(m, 10) = brr
End Sub
|
评分
-
1
查看全部评分
-
|