楼主要求用VBA解决，我们想到三种方法，一起来看一下吧（原表的行列字段有微调）：
VBA代码法
Sub TransFormData()
Dim arrData(), arrTem()
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim iRow As Integer, iCol As Integer
Dim i As Integer, j As Integer, k As Integer
Set wsSource = Sheets("原表")
arrData = wsSource.Range("A1").CurrentRegion.Value
iRow = UBound(arrData, 1)
iCol = UBound(arrData, 2)
Dim totalRows As Integer
totalRows = (iRow - 1) * (iCol - 1) 1
ReDim arrTem(1 To totalRows, 1 To 3)
arrTem(1, 1) = "ITEM"
arrTem(1, 2) = "数量"
arrTem(1, 3) = "日期"
k = 1
For i = 2 To iCol
For j = 2 To iRow
k = k 1
arrTem(k, 1) = arrData(j, 1)
arrTem(k, 2) = arrData(j, i)
arrTem(k, 3) = arrData(1, i)
Next
Next
'检查表"转置"是否存在，存在则清空，不存在则添加
On Error Resume Next
Set wsTarget = Worksheets("转置")
On Error GoTo 0
If wsTarget Is Nothing Then
Set wsTarget = Sheets.Add(After:=Sheets(Sheets.Count))
wsTarget.Name = "转置"
Else
wsTarget.Cells.Clear ' 清除
End If
'输出到 "转置" 表
wsTarget.Range("A1").Resize(totalRows, 3).Value = arrTem
End Sub
代码解析：
1、把原始数据读入数组arrData()。
2、根据数据行、列的数量，重新定义目标数组arrTem()。
3、循环数组arrData()的行、列，把数据写入数组arrTem()。
4、把结果写入工作表“转置”。
函数公式法
1、在表“公式”中输入表头。
2、在A2单元格输入公式：
=INDEX(原表!$A$2:$A$158,MOD(ROW(A1)-1,ROWS(原表!$A$2:$A$158)) 1,1)
3、在B2单元格输入公式：
=INDEX(原表!$B$2:$Y$158,MOD(ROW(A1)-1,ROWS(原表!$A$2:$A$158)) 1,INT((ROW(A1)-1)/ROWS(原表!$A$2:$A$158) 1))
4、在C2单元格输入公式：
=INDEX(原表!$B$1:$Y$1,1,INT((ROW(A1)-1)/ROWS(原表!$A$2:$A$158) 1))
5、选中A2:C2，往下拖，直到出现错误值为止。
6、也可以在上述公式前增加IFERROR函数容错。
数据透视表
1、选中所有列，插入数据透视，选择新建工作表。
2、把ITEM字段加到行，日期字段都加到“值”。
3、把右上列框里的∑数值拖到行：
则变成这样：
4、在设计菜单-->报表布局，选择“以表格形式显示”，再右击“ITEM”，字段设置-->布局和打印-->重复项目标签，结果如下：
5、复制整个表，粘贴为数值（如果需要重复使用这个数据透视表的，可以复制粘贴到另一张表)。
6、筛选删除空白、汇总项目，把所有“求和项：”替换为空，搞定。
喜欢就点个赞、点在看、留个言呗！需要示例文件的朋友请关注同名V公众号查看文件获取方式。
