[已解决]数据行变列

dong66094799

Sub Macro1()
Dim arr, brr, i&, j%, k%, s&
arr = Sheet1.Range("a1").CurrentRegion
w = Array(6, 7, 8, 9, 10, 14)
ReDim brr(1 To 60000, 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
    For j = 0 To UBound(w)
        If arr(i, w(j)) <> "" Then
            s = s + 1
            brr(s, w(j)) = arr(i, w(j))
            For k = 1 To 5
                brr(s, k) = IIf(k = 3, "'" & arr(i, k), arr(i, k))
            Next
            For k = 11 To 13
                brr(s, k) = arr(i, k)
            Next
        End If
    Next
Next
Sheet2.Activate
ActiveSheet.UsedRange.Clear
Sheet1.Rows(1).Copy [a1]
With Range("a2").Resize(s, UBound(brr, 2))
    .Value = brr
    .Borders.LineStyle = xlContinuous
End With
End Sub

第3列已修改为文本格式，第4列也要修改为文本格式。谢谢帮忙

秦安

学习了，谢谢大师

dsmch

dong66094799 发表于 2015-5-26 10:45
Sub Macro1()
Dim arr, brr, i&, j%, k%, s&
arr = Sheet1.Range("a1").CurrentRegio

brr(s, k) = IIf(k = 3 or k=4, "'" & arr(i, k), arr(i, k))