[英]How to convert column value to rows in vba Macro
I have a excel sheet that have 500 entries and contain 20 columns.Below is part of the excel sheet source.我有一个 excel 表,它有 500 个条目并包含 20 列。下面是 excel 表源的一部分。
CollegeId| Name| Rollnumber| Department| 'Januar 2020| 'Dezember 2019| November 2019 |'Oktober 2019 |4 Months Averge |4 months Sum.
One row of dataset一行数据集
4|ABC|DE010|IT|348140|168277|245604|103109|216283|865133|98253|11790337
Output of excel header. excel header 的 Output。
CollegeId| Name| Rollnumber| Department|Month|4 Months Averge |4 months Sum
4|ABC|DE010|IT|'Januar 2020|348140|216283|865132|98253|1179036
4|ABC|DE010|IT|'Dezember 2019|168277|216283|865132|98253|1179036
4|ABC|DE010|IT|November 2019|348140|216283|865132|98253|1179036
4|ABC|DE010|IT|'Oktober 2019|348140|216283|865132|98253|1179036
This is Excel sheet Input source table look like.这是 Excel 表输入源表的样子。
How can i convert Jan,Dec,Nov,Oct month into Month column with VBA excel code I hope i have explained well.如何使用 VBA excel 代码将 Jan、Dec、Nov、Oct 月份转换为 Month 列,希望我已经解释清楚。
Please help to write VBA code of that.请帮助编写 VBA 代码。 Out put table look like that输出表是这样的
Today i got solution for same,i think share to every one.今天我得到了相同的解决方案,我想分享给大家。
Below is code of above requirement.以下是上述要求的代码。
Sub TransposeData()
Dim LastRowRawDataSheet As Long, LastRowTransposeDetailsSheet As Long
Dim CurrentData As Range, MonthRange As Range
Application.ScreenUpdating = False
'Last Row Raw Data Sheet
LastRowRawDataSheet = RawDataSheet.Cells(Rows.Count, "A").End(xlUp).Row
'Last Row Transpose Details Sheet
LastRowTransposeDetailsSheet = TransposeDetailsSheet.Cells(Rows.Count, "A").End(xlUp).Row
'Clear Data --> Transpose Details Sheet
If LastRowTransposeDetailsSheet > 1 Then
TransposeDetailsSheet.Range("A2:F" & LastRowTransposeDetailsSheet).Clear
End If
'Month Range
Set MonthRange = RawDataSheet.Range("E1:H1")
TransposeDetailsSheet.Activate
For Each CurrentData In RawDataSheet.Range("A2:A" & LastRowRawDataSheet)
'Roll No.
TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "A").Value = CurrentData.Value
'Name
TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "B").Value = CurrentData.Offset(, 1).Value
'Id
TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "C").Value = CurrentData.Offset(, 2).Value
'DEPT
TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "D").Value = CurrentData.Offset(, 3).Value
'Fill Down
TransposeDetailsSheet.Range(TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "A"), TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "D")).AutoFill TransposeDetailsSheet.Range(TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "A"), TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 4, "D")), xlFillDefault
'Copy Month
MonthRange.Copy
'Paste Month into Transpose Details Sheet --> Month
TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "E").PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, False, True
Application.CutCopyMode = False
'Copy Data from "E:H" Column
RawDataSheet.Range(RawDataSheet.Cells(CurrentData.Row, "E"), RawDataSheet.Cells(CurrentData.Row, "H")).Copy
'Paste into Transpose Details --> Record
TransposeDetailsSheet.Cells(LastRowTransposeDetailsSheet + 1, "F").PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, False, True
Application.CutCopyMode = False
'Last Row Transpose Data Sheet
LastRowTransposeDetailsSheet = TransposeDetailsSheet.Cells(Rows.Count, "A").End(xlUp).Row
Next CurrentData
TransposeDetailsSheet.Activate
TransposeDetailsSheet.Range("A1").Activate
Application.ScreenUpdating = True
End Sub结束子
thanks for help.感谢帮助。
You can accumulate data using dynamic arrays.您可以使用动态 arrays 累积数据。
Sub test()
Dim Ws As Worksheet
Dim toWs As Worksheet
Dim vDB, vR()
Dim r As Long, i As Long, n As Long
Dim k As Integer, j As Integer
Set Ws = Sheets(1) '<~~ Data Sheet
Set toWs = Sheets(2) '<~~ Result Sheet
vDB = Ws.UsedRange
r = UBound(vDB, 1)
For i = 2 To r
If vDB(i, 1) <> "" Then
For j = 5 To 8
n = n + 1
ReDim Preserve vR(1 To 10, 1 To n)
For k = 1 To 4
vR(k, n) = vDB(i, k)
Next k
vR(5, n) = vDB(1, j)
vR(6, n) = vDB(i, j)
For k = 7 To 10
vR(k, n) = vDB(i, k + 2)
Next k
Next j
End If
Next i
With toWs
.UsedRange.Offset(1).Clear
.Range("a2").Resize(n, 10) = WorksheetFunction.Transpose(vR)
End With
End Sub
The structure of the data should be the same as the location of the cell address in the figure below.数据的结构应该和下图中单元格地址的位置一致。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.