数据处理，高手请进！

vincent.cn

有SHEET1中这样一组数据，需按一定条件处理成SHEET2中的形式，各位高手请进！数据见附件

zhaogang1960

试试看：
Sub Macro1()
    Dim rng As Range, arr(), c As Range, m As Integer,temp
    Set rng = Sheet1.Range("A1").SpecialCells(xlCellTypeConstants, 23)
    ReDim arr(1 To rng.Count)
    For Each c In rng
        If c.Interior.ColorIndex = xlNone Then
            m = m + 1
            arr(m) = c.Value
        ElseIf c.Interior.ColorIndex = 3 Then
            temp = c.Value
        End If
    Next
    arr(m + 1) = temp
    With Sheet2
        .Rows(2).ClearContents
        .Range("a2").Resize(1, m + 1) = arr
    End With
End Sub

vincent.cn

运行宏时出错1004，未找到单元格
这是怎么回事

zhaogang1960

数据.rar (8.8 KB, 下载次数: 26)

2009-6-16 23:02 上传

点击文件名下载附件

vincent.cn

不好意思，可以了，我还想问下，如果我有N组这样的数据，同时需要转化，需要做怎样的修改吗?

zhaogang1960

应该可以，请上传附件才好找到规律

vincent.cn

已上传10组数据，分2种情况。可否延伸至N组

zhaogang1960

Sub Macro1()
    Dim rng As Range, brr, arr(), ary(), c As Range
    Dim i As Long, lr As Long, m As Integer, temp
    With Sheet1
        lr = .Range("a65536").End(xlUp).Row
        brr = .Range("a1:a" & lr + 1)
    End With
    n = 1
    ReDim ary(1 To n)
    ary(1) = 1
    For i = 2 To lr + 1
        If brr(i, 1) <> brr(i - 1, 1) Then
            n = n + 1
            ReDim Preserve ary(1 To n)
            ary(n) = i
        End If
    Next
    With Sheet2
        .UsedRange.ClearContents
        For i = 1 To n - 1
            Set rng = Sheet1.Rows(ary(i) & ":" & ary(i + 1) - 1).SpecialCells(xlCellTypeConstants, 23)
            ReDim arr(1 To rng.Count)
            m = 0
            For Each c In rng
                If c.Interior.ColorIndex = xlNone Then
                    m = m + 1
                    arr(m) = c.Value
                ElseIf c.Interior.ColorIndex = 3 Then
                    temp = c.Value
                End If
            Next
            arr(m + 1) = temp
            .Cells(i, 1).Resize(1, m + 1) = arr
        Next
    End With
End Sub

vincent.cn

我导入整体数据后出现错误

vincent.cn

运行是错误1004
应用程序错误或对象定义错误
.Cells(i, 1).Resize(1, m + 1) = arr