当前位置：首页 → 问答吧 → 哪位老师帮助一下合并工作表？

哪位老师帮助一下合并工作表？

时间：2011-08-09

来源：互联网

有A公司和B公司，将两表汇总合并到合并表中。表中项目1是合并追加记录，项目2是合并计算。
谢谢！

附件

合并.rar(15.33 KB)

2011-8-9 13:25, 下载次数: 13

作者: daqml 发布时间: 2011-08-09

用透视表

作者: seeme 发布时间: 2011-08-09

是两个工作簿，合并到另一个工作簿。而且一个是追加记录，另一个是合并计算。，

作者: daqml 发布时间: 2011-08-09

复制内容到剪贴板

代码:

Sub zdgx()
Dim Arr, myPath$, myName$, sh As Worksheet
Dim m&, funm$, n&, Sht As Worksheet, i&, j&, r1
Application.ScreenUpdating = False
funm = "合并.xls"
For Each Sht In Sheets
      Sht.Cells.ClearContents
Next
myPath = ThisWorkbook.Path & "\"
myName = Dir(myPath & "*.xls")
Do While myName <> "" And myName <> funm
      With GetObject(myPath & myName)
         mm = mm + 1
         For Each sh In .Sheets
            m = sh.[a65536].End(xlUp).Row - 1
            nm = sh.Name
            If mm = 1 Then
                  Sheets(nm).[a1] = nm
                  Arr = sh.Range("a2:e" & m)
                  Sheets(nm).Cells(2, 1).Resize(UBound(Arr), 5) = Arr
            Else
                  Arr = sh.Range("a3:e" & m)
                  For i = 1 To UBound(Arr)
                     Set r1 = Sheets(nm).[a:a].Find(Arr(i, 1), , , 1)
                     If Not r1 Is Nothing Then
                        For j = 2 To 5
                              Sheets(nm).Cells(r1.Row, j) = Sheets(nm).Cells(r1.Row, j) + Arr(i, j)
                        Next
                     Else
                        n = Sheets(nm).[a65536].End(xlUp).Row + 1
                        For j = 1 To 5
                              Sheets(nm).Cells(n, j) = Arr(i, j)
                        Next
                     End If
                  Next
            End If
         Next
         .Close False
      End With
      myName = Dir
Loop
For Each Sht In Sheets
      m = Sht.[a65536].End(xlUp).Row + 1
      Sht.Cells(m, 1) = "Total:"
      Sht.Cells(m, 2).Formula = "=sum(r3c:r[-1]c)"
      Sht.Cells(m, 2).AutoFill Sht.Cells(m, 2).Resize(1, 4)
Next

Application.ScreenUpdating = True
End Sub

作者: 蓝桥玄霜发布时间: 2011-08-09

请见附件。