最近见到蛮多存在合并单元格的数据转置需求的。
源数据
源数据
结果
结果
处理方法：合并单元格中存在数据（非空）的行号，用变量标记，然后引用。
Sub CAT()
Dim arr, r, brr(1 To 50000, 1 To 5)
r = [a1024768].End(3).Row + 7 '//最后的行号，确定数据区域
arr = Range("a5:f" & r) '//数据源
For i = 1 To UBound(arr) Step 8 '//数据还有有规律的，8行一个合并单元格
t = i '//合并单元格中非空行的行号(在数组arr中的行号)
For m = 5 To 6 '//遍历耗材，其在数组的第5列和第6列
For n = 0 To 7 '//每个素材最多8个
If arr(i + n, m) <> "" Then '//有数据的耗材就提取
k = k + 1 '//计数
brr(k, 1) = arr(t, 1) '//引用合并单元格数据
brr(k, 2) = arr(t, 2)
brr(k, 3) = arr(t, 3)
brr(k, 4) = arr(t, 4)
brr(k, 5) = arr(i + n, m) '//耗材
End If
Next
Next
Next
[h5:L55555] = ""
[h5].Resize(k, 5) = brr '//输出转置数据
End Sub
示例文件下载：
链接: http://pan.baidu.com/s/1i4AtZKx 密码: xwns
