[已解决]单元格处理

neilni

请教各位，具体可以看附件，如何写代码，谢谢！

最佳答案

月排行榜 / 总排行榜

scl5801

2016-8-8 18:09

试试吧。
Sub test()
    Dim arr, brr, ar, s%, i%, j%, x%
    arr = Sheet7.Range("a1:a126")
    ReDim brr(1 To UBound(arr), 1 To 2)
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then
           ar = Split(arr(i, 1), "：")
           s = s + 1
           brr(s, 1) = ar(0): brr(s, 2) = ar(1)
        End If
    Next
    ReDim arr(1 To s, 1 To 8)
    For i = 1 To 8
        arr(1, i) = brr(i, 1)
    Next
    For i = 1 To s Step 8
        x = x + 1
        For j = 1 To 8
          arr(x + 1, j) = brr(i + j - 1, 2)
        Next
    Next
    [c1].Resize(UBound(arr), 8) = arr
End Sub

跳转到最佳答案楼层

scl5801

试试吧。
Sub test()
    Dim arr, brr, ar, s%, i%, j%, x%
    arr = Sheet7.Range("a1:a126")
    ReDim brr(1 To UBound(arr), 1 To 2)
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then
           ar = Split(arr(i, 1), "：")
           s = s + 1
           brr(s, 1) = ar(0): brr(s, 2) = ar(1)
        End If
    Next
    ReDim arr(1 To s, 1 To 8)
    For i = 1 To 8
        arr(1, i) = brr(i, 1)
    Next
    For i = 1 To s Step 8
        x = x + 1
        For j = 1 To 8
          arr(x + 1, j) = brr(i + j - 1, 2)
        Next
    Next
    [c1].Resize(UBound(arr), 8) = arr
End Sub