[英]Transpose a dynamic range data from vertical to horizontal format
This is the data given to me, you can see the columns B and C are similar in all aspects except the Export items data:这是给我的数据,你可以看到除了出口项目数据外,B列和C列在所有方面都相似:
This is the data which is transposed to horizontal way without VBA code:这是在没有 VBA 代码的情况下转换为水平方式的数据:
Only issue is whenever i try doing it via VBA code, i don't get the remaining data as it is.唯一的问题是,每当我尝试通过 VBA 代码执行此操作时,我都不会按原样获取剩余数据。 it comes in as jumbled.它杂乱无章。
Sub test2()
Dim Ws As Worksheet
Dim toWs As Worksheet
Dim vDB, vR()
Dim rngDB As Range
Dim i As Long, j As Long, n As Long
Dim r As Long, c As Long, k As Long
Set Ws = Sheets(1)
Set toWs = Sheets(2)
Set rngDB = Ws.Range("a1").CurrentRegion
vDB = rngDB
r = UBound(vDB, 1)
c = UBound(vDB, 2)
For j = 2 To c
n = n + 1
'ReDim Preserve vR(1 To 4, 1 To n)
ReDim Preserve vR(1 To 5, 1 To n)
vR(1, n) = vDB(1, j)
vR(2, n) = vDB(2, j)
vR(3, n) = vDB(3, j)
vR(4, n) = vDB(4, j)
vR(5, n) = vDB(r, j) 'added insurance
'For i = 5 To r
For i = 5 To r - 1
If vDB(i, j) <> "" Then
n = n + 1
ReDim Preserve vR(1 To 5, 1 To n)
vR(4, n) = vDB(i, j)
End If
Next i
Next j
With toWs
k = .UsedRange.Rows.Count + 1
'.Range("a" & k).Resize(n, 4) = WorksheetFunction.Transpose(vR)
.Range("a" & k).Resize(n, 5) = WorksheetFunction.Transpose(vR)
End With
End Sub
Try this:尝试这个:
Sub Test2()
Dim i&, j&, vIn, vOut
With ThisWorkbook
vIn = .Worksheets(1).Range("a1").CurrentRegion.Value2
ReDim vOut(1 To UBound(vIn, 2), 1 To UBound(vIn, 1))
For i = 1 To UBound(vIn, 1)
For j = 1 To UBound(vIn, 2)
vOut(j, i) = vIn(i, j)
Next
Next
.Worksheets(2).Range("a1").Resize(UBound(vOut, 1), UBound(vOut, 2)) = vOut
End With
End Sub
A more generic, reusable, and functional way to do it would be like so...一种更通用、可重用和功能性的方式来做到这一点......
Sub Test3()
Dim vIn
With ThisWorkbook
vIn = .Worksheets(1).[a1].CurrentRegion.Value2
.Worksheets(2).[a1].Resize(UBound(vIn, 2), UBound(vIn, 1)) = MyTranspose(vIn)
End With
End Sub
Function MyTranspose(vIn)
Dim i&, j&, vOut
ReDim vOut(1 To UBound(vIn, 2), 1 To UBound(vIn, 1))
For i = 1 To UBound(vIn, 1)
For j = 1 To UBound(vIn, 2)
vOut(j, i) = vIn(i, j)
Next
Next
MyTranspose = vOut
End Function
Transpose data转置数据
tltr; tltr; and I didn't follow the prior discussion ... but why not just apply Application.Transpose()
to the entire data set instead of executing inner and outer loops?而且我没有按照前面的讨论...但为什么不将Application.Transpose()
应用于整个数据集而不是执行内部和外部循环?
Option Explicit ' declaration head of code module
Sub TransposeData()
'[1]get data and assign them to variant 1-based 2-dim array
Dim v ' As Variant
v = Sheet1.Range("A1").CurrentRegion.Value2 ' << change to your source worksheet's CodeName
'[2]transpose data and write to target sheet - e.g. Code(Name) Sheet2
Sheet2.Range("A1").Resize(UBound(v, 2), UBound(v, 1)) = Application.Transpose(v)
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.