[已解决]请教:多行转置为一列的宏

海水鱼

请看附件，谢谢

最佳答案

月排行榜 / 总排行榜

yuhe0008

2016-2-16 22:27

Sub zh()
    Dim arr(), s%, i%, r As Range, rn As Range
    Set rn = Range("c3").CurrentRegion
    s = rn.Count
    ReDim arr(1 To s)
    For Each r In rn
        If r <> "" Then
            i = i + 1
            arr(i) = r.Value
        End If
    Next
    Range("m3").Resize(s) = Application.Transpose(arr)
End Sub

跳转到最佳答案楼层

wqjyyylkz

可以参考附件多行变一列自己去录制宏

海水鱼

wqjyyylkz 发表于 2016-2-16 14:42
可以参考附件多行变一列自己去录制宏

打不开

wqjyyylkz

再次附上，请查看

海水鱼

顶上不要沉了

scl5801

海水鱼 发表于 2016-2-16 18:04
顶上不要沉了

Sub zzh()
  Dim h%, i%, k, arr, brr
  h = Cells(Rows.Count, 3).End(xlUp).Row
  arr = Range("c3:k" & h)
  ReDim brr(1 To UBound(arr, 1) * UBound(arr, 2), 1 To 1)
  For i = 1 To UBound(arr, 1)
    For h = 1 To UBound(arr, 2)
      If arr(i, h) <> "" Then
        k = k + 1
        brr(k, 1) = arr(i, h)
      End If
    Next h
  Next i
  [m3].Resize(UBound(brr), 1) = brr
End Sub

yuhe0008

Sub zh()
    Dim arr(), s%, i%, r As Range, rn As Range
    Set rn = Range("c3").CurrentRegion
    s = rn.Count
    ReDim arr(1 To s)
    For Each r In rn
        If r <> "" Then
            i = i + 1
            arr(i) = r.Value
        End If
    Next
    Range("m3").Resize(s) = Application.Transpose(arr)
End Sub