PDA

View Full Version : [SOLVED] Table transpose



idnoidno
09-01-2017, 07:26 AM
20232

Data in the source worksheet, I want to get the target worksheet(There are hundreds of data), I thought for a long time but do not know how to solve it, I hope someone can provide a solution.Any help is very grateful.

YasserKhalil
09-01-2017, 08:10 AM
Hello idnoidno
Try this code


Sub Test()
Dim ws As Worksheet
Dim sh As Worksheet
Dim a() As Variant
Dim rng As Range
Dim r As Range
Dim c As Range
Dim i As Long
Dim x As Long


Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets("source")
Set sh = ThisWorkbook.Worksheets("target")

For Each r In ws.Columns(1).SpecialCells(2).Areas
Set rng = r.CurrentRegion

For Each c In rng.Columns
If Application.WorksheetFunction.CountA(c) > 1 And c.Column <> 1 Then
x = x + 1
ReDim Preserve a(1 To 5, 1 To x)
a(1, x) = rng(1)
For i = 2 To UBound(a, 1)
a(i, x) = rng(c.Column)(i - 1)
Next i
a(2, x) = CLng(a(2, x))
End If
Next c
Next r

With sh
With .Cells
.Clear: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter: .RowHeight = 18
End With
.Range("A1").Resize(1, 5).Value = Array("Item", "Date", "L", "W", "H")
.Range("A1").Resize(1, 5).Font.Bold = True
.Range("A2").Resize(UBound(a, 2), UBound(a, 1)).Value = Application.Transpose(a)
.Range("A1").CurrentRegion.Borders.Value = 1
.Columns(2).NumberFormat = "m/d/yyyy": .Columns(2).ColumnWidth = 13
End With
Application.ScreenUpdating = True
End Sub

idnoidno
09-01-2017, 05:00 PM
Mr.YasserKhalil ,thank you very much.


I do not understand your CODE, can you take some time to explain, if I can learn your knowledge I will be very grateful.

YasserKhalil
09-01-2017, 10:35 PM
You're welcome. Glad I can offer some help for you
As for the code first define the sheets "source" and "target" then loop through areas (separated by empty rows) so as to deal with each table ..and inside that loop the code would count the columns with data except first column and then use the variable x to increase every time the criteria is achieved.
Using an array of 5 rows and then using redim preserve to increase the columns according to the variable x ..filling the array with the desired output
Then some formatting lines

You can press F8 to execute the code line by line and sorry because English is not my native language
May be someone else explain better than me

idnoidno
09-02-2017, 07:24 AM
Mr.YasserKhalil ,thank you again.Are you Japanese?
English is not my native language,either.
These codes

For Each r In ws.Columns(1).SpecialCells(2).Areas
Set rng = r.CurrentRegion

For Each c In rng.Columns
If Application.WorksheetFunction.CountA(c) > 1 And c.Column <> 1 Then
x = x + 1 ㄎㄛ
ReDim Preserve a(1 To 5, 1 To x)
a(1, x) = rng(1)
For i = 2 To UBound(a, 1)
a(i, x) = rng(c.Column)(i - 1)
Next i
a(2, x) = CLng(a(2, x))
End If
Next c ext r


I rarely use this way to write code, I use F8 to excute each code but still do not understand,but it is ok,I will google some information to learn.If you can recommend some of the site information, I would be very grateful.

YasserKhalil
09-02-2017, 09:44 AM
May be one of the experts volunteer to explain in more professional way
Regards