- Sub aaa()
- Dim i&, j&, n&, arr(1 To 10000, 1 To 3), brr, r&
- With Sheets(1)
- For i = 2 To .[a65536].End(3).Row
- n = .Cells(i, 1).MergeArea.Rows.Count
- brr = Split(.Cells(i, 1), " ")
- For j = 0 To UBound(brr)
- r = r + 1
- arr(r, 1) = brr(j)
- arr(r, 2) = .Cells(i + n - 1, 6)
- arr(r, 3) = .Cells(i + n - 1, 7)
- Next j
- i = i + n - 1
- Next i
- End With
- Sheets(2).[a2].Resize(r, 3) = arr
- End Sub
复制代码 |