请求ZHAOGANG老师出手，关于数据整理

zhurongking

关于数据整理，将纵向对应某一物料的料号，进行横向排列，数据量比较大，有好几组，详细见附件。谢谢老师

zhaogang1960

Sub 宏1()
    Dim arr, brr(), crr(), i&, j&, m&, n&
    arr = Range("G6").CurrentRegion
    ReDim brr(1 To UBound(arr))
    For i = 1 To UBound(arr)
        If arr(i, 1) = "BASE #" Then
            m = m + 1
            brr(m) = i
        End If
    Next
    brr(m + 1) = i
    ReDim crr(1 To UBound(arr) * UBound(arr, 2), 1 To 2)
    For ii = 1 To m
        For j = 2 To UBound(arr, 2)
            If arr(brr(ii), j) = "COMMENTS" Then Exit For
            For i = brr(ii) + 2 To brr(ii + 1) - 1
                If Len(arr(i, j)) Then
                    n = n + 1
                    crr(n, 1) = arr(brr(ii) + 1, 1) & "-" & arr(brr(ii) + 1, j)
                    crr(n, 2) = arr(i, 1) & "-" & arr(i, j)
                End If
            Next
        Next
    Next
    With Sheets("Sheet2")
        .UsedRange.ClearContents
        .[a1].Resize(n, 2) = crr
    End With
End Sub

zhaogang1960

欢迎新会员zhurongking ，请看附件：
New Microsoft Office Excel 2007 工作簿 (4).rar (22.57 KB, 下载次数: 21)

2011-7-6 00:31 上传

点击文件名下载附件