求修改代码 单元格内容超过了255 不能用Transpose

bavinfeather

单元格内容超过255的限制，所以不能用以下代码

1. [A1].Resize(nFill, 13) = Application.WorksheetFunction.Transpose(vFill)

复制代码

因为不是普通的合并，列数顺序是乱的，所以不知道怎么在数组中转制  求大神修改附件

QIUZHU.rar (83.48 KB, 下载次数: 6)

2018-12-20 14:47 上传

点击文件名下载附件

microyip

自建转置函数

1. Function TranVariant(ByVal vData As Variant) As Variant
   
2. '转置数组
   
3.     Dim vNewData As Variant, nRow As Double, nCol As Double
   
4.    
   
5.     If IsArray(vData) Then
   
6.         ReDim vNewData(1 To UBound(vData, 2) - LBound(vData, 2) + 1, 1 To UBound(vData) - LBound(vData) + 1)
   
7.         For nRow = 1 To UBound(vNewData)
   
8.             For nCol = 1 To UBound(vNewData, 2)
   
9.                 If Not IsNull(vData(nCol + LBound(vData, 2) - 1, nRow + LBound(vData) - 1)) Then _
   
10.                     vNewData(nRow, nCol) = vData(nCol + LBound(vData, 2) - 1, nRow + LBound(vData) - 1)
    
11.             Next
    
12.         Next
    
13.         vData = vNewData
    
14.     End If
    
15.     TranVariant = vData
    
16. End Function
    

复制代码

microyip

原代码改成

1. [A1].Resize(nFill, 13) =TranVariant(vFill)

复制代码

bavinfeather

microyip 发表于 2018-12-21 08:10
原代码改成

1. If Not IsNull(vData(nCol + LBound(vData, 2) - 1, nRow + LBound(vData) - 1)) Then _

复制代码

这个提示 下标越界~

bavinfeather

microyip 发表于 2018-12-21 08:10
原代码改成

顶~求大神帮忙~

Zamyi

如果没有Transpose，你怎么做？

microyip

http://club.excelhome.net/thread-1453109-1-1.html
请参考新发的分享贴

bavinfeather

microyip 发表于 2018-12-24 11:03
http://club.excelhome.net/thread-1453109-1-1.html
请参考新发的分享贴

1.   If Not IsNull(vData(nCol + LBound(vData, 2) - 1, nRow + LBound(vData) - 1)) Then _

复制代码

大神，抄了之后 这句代码还是提示下标越界~

microyip

bavinfeather 发表于 2018-12-24 11:14
大神，抄了之后 这句代码还是提示下标越界~

已修改，重新COPY吧

bavinfeather

microyip 发表于 2018-12-24 12:24
已修改，重新COPY吧

没有问题了~谢谢~