以文本方式查看主题

-  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)

--  作者:johnnie_zheng
--  发布时间:2013/4/26 9:04:00
--  Excel报表合并后横着排列
    请问,Excel报表合并后,如何做到以下的效果
图片点击可在新窗口打开查看此主题相关图片如下:图像 3.png
图片点击可在新窗口打开查看
通过产品来排列
[此贴子已经被作者于2013-4-26 9:05:07编辑过]

--  作者:johnnie_zheng
--  发布时间:2013/4/26 9:33:00
--  
  没人知道怎弄吗?
--  作者:e-png
--  发布时间: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

[此贴子已经被作者于2013-4-26 11:43:49编辑过]