Excel transpose using VB

前端 未结 2 1862
再見小時候
再見小時候 2021-01-29 10:16

I am using VB to show large data in excel. They show up in A1:A3000. I am transposing A1:A6 to B1:G1 using this code:

sheet.Range(\"A1:A6\").Copy()
sheet.Range(\         


        
相关标签:
2条回答
  • 2021-01-29 10:51

    Does this work for you?

    Sub Test()
      Dim R1 As Long, R2 As Long, C2 As Long
      R2 = 1
      C2 = 2
      For R1 = 1 To ActiveSheet.UsedRange.Rows.Count
        Cells(R2, C2) = Cells(R1, 1)
        If C2 < 7 Then
          C2 = C2 + 1
        Else
          R2 = R2 + 1
          C2 = 2
        End If
      Next R1
    End Sub
    
    0 讨论(0)
  • 2021-01-29 10:58

    Please note that the code is in VBA.
    Instead of doing copy/paste, it transforms the content of the range (i.e array)

    Option Explicit
    
    Sub Tabulate(ByVal src As Range, ByVal splitSize As Integer, _
    ByVal destRangeStart As Range)
    Dim i As Integer
    Dim rangeToCopy As Range
    Dim rangeToPasteOver As Range
    
    Set rangeToCopy = src
    Set rangeToPasteOver = destRangeStart
    
    Debug.Print Now
    Application.ScreenUpdating = False
    For i = 1 To src.Cells.Count Step splitSize
    '    rangeToCopy.Resize(splitSize).Copy
    '    rangeToPasteOver.PasteSpecial Transpose:=True
    
        rangeToPasteOver.Resize(ColumnSize:=splitSize).Value = _
            Transform2DArray(rangeToCopy.Resize(splitSize).Value)
    
        Set rangeToCopy = rangeToCopy.Offset(splitSize)
        Set rangeToPasteOver = rangeToPasteOver.Offset(1)
    Next
    Application.ScreenUpdating = True
    
    Debug.Print Now
    End Sub
    Function Transform2DArray(ByVal src As Variant) As Variant
    Dim returnValue As Variant
    
    Dim rowCtr As Long
    Dim colCtr As Long
    
    Dim destColCtr As Long
    Dim destRowCtr As Long
    
    
    Dim lRows As Long
    Dim uRows As Long
    
    Dim lCols As Long
    Dim uCols As Long
    
    lRows = LBound(src, 1)
    uRows = UBound(src, 1)
    
    lCols = LBound(src, 2)
    uCols = UBound(src, 2)
    
    ReDim returnValue(lCols To uCols, lRows To uRows)
    
    destRowCtr = lCols
    
    For colCtr = lCols To uCols
        destColCtr = lRows
        For rowCtr = lRows To uRows
            returnValue(destRowCtr, destColCtr) = src(rowCtr, colCtr)
            destColCtr = destColCtr + 1
        Next
        destRowCtr = destRowCtr + 1
    Next
    
    Transform2DArray = returnValue
    End Function
    
    0 讨论(0)
提交回复
热议问题