|
发表于 2015-9-11 15:15
|
显示全部楼层
本楼为最佳答案
sj_dcy 发表于 2015-9-11 14:58
是的 刚才测试 要是数据多的话 下面的的一些就没有边框了
现在不是有了吗?- Sub XXX()
- Dim arr, brr, srr, a&, x&, s&
- arr = Range("a1").CurrentRegion
- ReDim brr(1 To UBound(arr) * UBound(arr, 2), 1 To 4)
- For a = 2 To UBound(arr)
- If arr(a, 4) <> "" Then
- srr = Split(arr(a, 4), ",")
- For s = 0 To UBound(srr)
- x = x + 1
- brr(x, 1) = arr(a, 1)
- brr(x, 2) = arr(a, 2)
- brr(x, 3) = arr(a, 3)
- brr(x, 4) = srr(s)
- Next
- End If
- Next
- ActiveSheet.Copy after:=Sheets(Sheets.Count)
- With ActiveSheet
- Intersect(.UsedRange, .UsedRange.Offset(1)).ClearContents
- .[a2].Resize(x, 4) = brr
- .Rows(1).Copy
- .UsedRange.PasteSpecial Paste:=xlPasteFormats
- .UsedRange.Borders.LineStyle = 1
- End With
- End Sub
复制代码 |
|