[已解决]Sheet1 A列的数据提取到Sheet2第1行

hanjia

把Sheet1 A列的数据提取到Sheet2第1行
再把第1行2个以上的提取到第2行提取如付件的Sheet2


Excel 工作表.zip (7.45 KB, 下载次数: 8)

2016-8-10 18:16 上传

点击文件名下载附件

下面这段是把Sheet1的A列提取到Sheet2第2行了
怎么增加把Sheet2的第1行有2个数据的提取到第2行

Sub TEST()
    D = 1
    ARR = Range("A1:A" & Range("A65536").End(3).Row)
    ReDim T(1 To 1)
    T(D) = ARR(1, 1)
    Z = ARR(1, 1)
    For I = 2 To UBound(ARR)
        If ARR(I, 1) = Z Then
            T(D) = T(D) & Chr(10) & ARR(I, 1)
        Else
            D = D + 1
            ReDim Preserve T(1 To D)
            T(D) = ARR(I, 1)
            Z = ARR(I, 1)
        End If
    Next
    Sheets(2).Range("A1").Resize(1, UBound(T)) = T
End Sub

最佳答案

月排行榜 / 总排行榜

scl5801

2016-8-10 18:57

Sub TEST()
    d = 1
    r = Sheet1.Range("A65536").End(3).Row
    ARR = Sheet1.Range("A1:A" & r)
    ReDim t(1 To 2, 1 To UBound(ARR))
    t(1, d) = ARR(1, 1)
    Z = ARR(1, 1)
    For i = 2 To UBound(ARR)
        If ARR(i, 1) = Z Then
            t(1, d) = t(1, d) & Chr(10) & ARR(i, 1)
        Else
            d = d + 1
'            ReDim Preserve t(1 To d)
            t(1, d) = ARR(i, 1)
            Z = ARR(i, 1)
        End If
    Next
    d = 0
    For i = 1 To UBound(t, 2)
       If Len(t(1, i)) > 1 Then
          d = d + 1
          t(2, d) = t(1, i)
       End If
    Next
    Sheets(2).Range("A1").Resize(2, UBound(t, 2)) = t
End Sub

跳转到最佳答案楼层

scl5801

Sub TEST()
    d = 1
    r = Sheet1.Range("A65536").End(3).Row
    ARR = Sheet1.Range("A1:A" & r)
    ReDim t(1 To 2, 1 To UBound(ARR))
    t(1, d) = ARR(1, 1)
    Z = ARR(1, 1)
    For i = 2 To UBound(ARR)
        If ARR(i, 1) = Z Then
            t(1, d) = t(1, d) & Chr(10) & ARR(i, 1)
        Else
            d = d + 1
'            ReDim Preserve t(1 To d)
            t(1, d) = ARR(i, 1)
            Z = ARR(i, 1)
        End If
    Next
    d = 0
    For i = 1 To UBound(t, 2)
       If Len(t(1, i)) > 1 Then
          d = d + 1
          t(2, d) = t(1, i)
       End If
    Next
    Sheets(2).Range("A1").Resize(2, UBound(t, 2)) = t
End Sub