- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- Excel报表合并后横着排列 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=32122)
-- 发布时间：2013/4/26 9:04:00
-- Excel报表合并后横着排列
请问，Excel报表合并后，如何做到以下的效果
此主题相关图片如下：图像 3.png
通过产品来排列
-- 发布时间：2013/4/26 9:33:00
--
没人知道怎弄吗？
-- 发布时间：2013/4/26 10:17:00
--
应该可以就是太麻烦， 要不你用专业报表（也麻烦，呵呵）。
-- 发布时间：2013/4/26 10:38:00
--
是按产品纵向分栏吗？
可以试试按产品分别做EXCEL报表，然后通过vba 拷贝合并成一个文档
Ws.Rows("1:" & 5).Copy(Ws.Range("a" & 10))
供参考：
Sub HBSJ() \'合并指定目录中所有文件中相同格式工作表的数据
Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
Application.ScreenUpdating = False \'冻结屏幕，以防屏幕抖动
myPath = ThisWorkbook.Path & "\\分表\\" \'把文件路径定义给变量
myFile = Dir(myPath & "*.xls") \'依次找寻指定路径中的*.xls文件
Do While myFile <> "" \'当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) \'打开符合要求的文件
For i = 1 To AK.Sheets.Count \'打开工作表
aRow = AK.Sheets(i).Range("a65536").End(xlUp).row \'打开的工作表A列总行数
tRow = ThisWorkbook.Sheets("Sheet1").Range("b65536").End(xlUp).row + 1 \'存货档案Sheet1数据行数
If aRow > 1 Then
\'AK.Sheets(i).Select
AK.Sheets(i).Range("a2:a" & aRow).Copy ThisWorkbook.Sheets("Sheet1").Range("b" & tRow) \'取得第3行a:f列以后的数据
AK.Sheets(i).Range("b2:b" & aRow).Copy ThisWorkbook.Sheets("Sheet1").Range("g" & tRow)
AK.Sheets(i).Range("c2:c" & aRow).Copy ThisWorkbook.Sheets("Sheet1").Range("i" & tRow)
AK.Sheets(i).Range("d2:d" & aRow).Copy ThisWorkbook.Sheets("自定义").Range("h" & tRow)
AK.Sheets(i).Range("e2:e" & aRow).Copy ThisWorkbook.Sheets("自定义").Range("i" & tRow)
AK.Sheets(i).Range("f2:f" & aRow).Copy ThisWorkbook.Sheets("自定义").Range("l" & tRow)
End If
Next
Workbooks(myFile).Close False \'关闭源工作簿,并不作修改
End If
MsgBox "正在导入" & myFile & "中数据", 64, "提示"
myFile = Dir \'找寻下一个*.xls文件
Loop
Application.ScreenUpdating = True \'冻结屏幕,此类语句一般成对使用
MsgBox "数据导入完成，请查看！", 64, "提示"
End Sub