PDA

View Full Version : [SOLVED] Data Tabulation



Romulo Avila
06-06-2017, 04:59 PM
Good evening,

I have a spreadsheet where the data is arranged as they are in the cells A1: K4, I need a VBA code so that the data is in accordance with the N1: R25 cells.

Thank you in advance for your support.

YasserKhalil
06-06-2017, 05:26 PM
Hello .. Try this code


Sub Test()
Dim arr As Variant
Dim temp As Variant
Dim i As Long
Dim j As Long
Dim k As Long


arr = Range("A1").CurrentRegion.Value
ReDim temp(1 To UBound(arr, 1) * 8, 1 To 5)
j = 1


For i = 2 To UBound(arr, 1)
For k = 3 To 10
temp(j, 1) = arr(i, 1)
temp(j, 2) = arr(i, 2)
temp(j, 3) = arr(i, 11)
temp(j, 4) = arr(1, k)
temp(j, 5) = arr(i, k)


j = j + 1
Next k
Next i


Range("N1").Resize(, 5).Value = Array("Model", "Status", "Value", "Size", "Qtd")
Range("N2").Resize(UBound(temp, 1), UBound(temp, 2)).Value = temp
End Sub

Bob Phillips
06-07-2017, 12:34 AM
An alternative


Public Sub Test()
Dim numcols As Long, numrows As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

numcols = .Range("A1").End(xlToRight).Column - 3
numrows = .Cells(.Rows.Count, "A").End(xlUp).Row - 1

.Range("N1:R1").Value = Array("Model", "Status", "Value", "Size", "Qtd")
For i = 1 To numrows

.Cells((i - 1) * 8 + 2, "N").Resize(numcols).Value = .Cells(i + 1, "A").Value
.Cells((i - 1) * 8 + 2, "O").Resize(numcols).Value = .Cells(i + 1, "B").Value
.Cells((i - 1) * 8 + 2, "P").Resize(numcols).Value = .Cells(i + 1, "K").Value
.Cells((i - 1) * 8 + 2, "Q").Resize(numcols).Value = Application.Transpose(.Range("C1").Resize(, numcols))
Next i

With .Range("R2").Resize(numrows * numcols)

.FormulaR1C1 = "=INDEX(R1C1:R" & numrows + 1 & "C" & numcols + 3 & ",MATCH(RC[-4],R1C1:R" & numrows + 1 & "C1,0),MATCH(RC[-1],R1C1:R1C" & numcols + 3 & ",0))"
.Value = .Value
End With

.Range("P2").Resize(numrows * numcols).NumberFormat = "#,##0.00"
End With

Application.ScreenUpdating = True
End Sub

Romulo Avila
06-07-2017, 05:56 AM
Good Morning,

Thank you all for your help.