合并数据

张雄友

合并数据.

fangyongshun

1. Sub 合并()
   
2. For Each sh In Sheets
   
3.     If sh.Name <> "总表" Then
   
4.         sh.Range("a1").CurrentRegion.Offset(1, 0).Copy Sheet4.Range("a" & Sheet4.[a65536].End(3).Row + 1)
   
5.     End If
   
6. Next
   
7. End Sub

复制代码

试试！！

yaozong

Sub 合并汇总分表数据() '
Application.ScreenUpdating = False
Dim sh As Worksheet
Dim d, arr, brr, s$, i, j, m
Sheet1.Activate
[A1].CurrentRegion.Offset(1).Clear
For Each sh In Sheets
    If sh.Name <> "总表" Then
        sh.Range("a2").CurrentRegion.Offset(1, 0).Copy [a65536].End(3).Offset(1)
    End If
Next
[A1].CurrentRegion.Offset(1).Sort [a2], 1
Set d = CreateObject("scripting.dictionary")
arr = [A1].CurrentRegion
brr = arr
For i = 1 To UBound(arr)
    s = arr(i, 1) & arr(i, 2)
    If Not d.exists(s) Then
       m = m + 1
       d(s) = m
       For j = 1 To 4
          brr(m, j) = arr(i, j)
       Next
    Else
       brr(d(s), 3) = brr(d(s), 3) + arr(i, 3)
    End If
Next
[A1].CurrentRegion.Clear
[A1].Resize(m, 4) = brr
Set d = Nothing
Application.ScreenUpdating = True
End Sub

yaozong

参考附件。。。

mjzxlmg

Sub test()
Dim arr, brr(1 To 100000, 1 To 4), i&, j&, m&, sh As Worksheet
For Each sh In Sheets
    If sh.Name <> "总表" Then
        arr = sh.[a1].CurrentRegion.Value
        For i = 2 To UBound(arr)
            m = m + 1
            For j = 1 To 4
                brr(m, j) = arr(i, j)
            Next
        Next
    End If
Next
Sheets("总表").[a1].CurrentRegion.Offset(1).ClearContents
Sheets("总表").[a2].Resize(m, 4).Value = brr
end sub

yaozong

纯合并时:
Sub 合并()
Application.ScreenUpdating = False
Dim sh As Worksheet
Sheets("总表").[a1].CurrentRegion.Offset(1).Clear
For Each sh In Sheets
    If sh.Name <> "总表" Then
        sh.Range("a2").CurrentRegion.Offset(1, 0).Copy Sheets("总表").[a65536].End(3).Offset(1)
    End If
Next
Application.ScreenUpdating = True
End Sub

yaozong

参考附件(含合并与汇总二个程序)

张雄友

fangyongshun 发表于 2012-11-13 08:15
试试！！

你的代码不能实现，谢谢。

senhuan

数据透视表
1.随便新建一个工作簿
2.Alt+D+D+D打开“导入外部数据向导”
3.选取源数据文件
4.新建数据透视表，修改SQL，看操作

SQL:
select * from [1$] union all select * from [2$] union all select * from [3$] union all select * from [4$] union all select * from [5$] union all select * from [6$] union all select * from [7$] union all select * from [8$]

fangyongshun

张雄友 发表于 2012-11-13 13:04
你的代码不能实现，谢谢。

1. Sub 合并汇总分表数据()
   
2. Set cnn = CreateObject("adodb.connection")
   
3. cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0';data source=" & ThisWorkbook.FullName
   
4. For Each sh In Sheets
   
5.     If sh.Name <> "总表" Then
   
6.         Sql = "select 日期,品名,销量,备注 from [" & sh.Name & "$] union all " & Sql
   
7.     End If
   
8. Next
   
9. sql1 = "transform sum(销量) select 日期,品名 from " & "(" & Left(Sql, Len(Sql) - 10) & ") group by 日期,品名 pivot '临时'"
   
10. Debug.Print sql1
    
11. Sheet1.Range("a2").CopyFromRecordset cnn.Execute(sql1)
    
12. Set cnn = Nothing
    
13. End Sub

复制代码

补充一个 sql方法