2024-09-08 12:14:21
使用宏需要一定的基础,完全给出不用调试的代码需要给出原表的全屏图。
下面是根据帖子图片编写的程序代码:
注意,程序在模块里面,程序中的表名sheet1、sheet2需要自行修改,如果是在不同的EXCEL文件中,还应该写为workbooks("book1").sheets("sheett1")这样的格式。
下面是测试数据:
下面的测试数据运行产生的测试结果:
程序只产生A2开始的结果,标题行请自行添加。
最后强调,如果实际数据与帖子图片格式不同,例如数据开始行3,例如指标个数和列,那么代码需要适当的修改,希望自行理解代码的情况调整,代码文本如下:
Option Explicit
Sub 转换格式()
Dim arr1, arr2, i&, j&, n&
arr1 = Sheets("sheet1").UsedRange 'sheet1是原始数据表名,请自行修改
ReDim arr2(1 To UBound(arr1) * 5, 1 To 6)
For i = 3 To UBound(arr1) '原表正式数据从第3行开始,请检查确认
For j = 4 To 8
If arr1(i, j) <> "" Then
n = n + 1
arr2(n, 1) = arr1(i, 1)
arr2(n, 2) = arr1(i, 1)
arr2(n, 3) = arr1(i, 1)
arr2(n, 4) = arr1(2, j)
arr2(n, 5) = arr1(i, j)
arr2(n, 6) = arr1(i, 9)
End If
Next j
Next i
Sheets("sheet2").Range("a2").Resize(n, 6) = arr2 'sheet2是结果表名,请自行修改
End Sub
2024-09-08 15:22:23
2024-09-08 14:14:00
参考
Excel数据批量转置(多列转三列)
2024-09-08 13:03:03