根据指定条件汇总

headtrain

各位DX，有一个小小的需求，
点击“汇总”按钮，将源工作簿的源工作表的源区域复制到本工作簿的目标工作表的目标区域
（粘贴时采用数值粘贴的方式）

代码怎么写呢？非常感谢！

魂断蓝桥

Sub 批量复制模板并命名()
Dim mypath$, myfile$
Dim cnn As Object
Dim Sql As String
Set cnn = CreateObject("ADODB.CONNECTION")
mypath = ThisWorkbook.Path & "\"
myfile = Dir(mypath & "*.xlsb")
Do While myfile <> ""
    If myfile <> ThisWorkbook.Name Then
        cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=NO'; Data Source=" & mypath & myfile
        Sql = "select * from [结论$d3:f8]"
            With Sheets(Replace(myfile, ".xlsb", ""))
                .[C3:E8] = ""
                .[c3].CopyFromRecordset cnn.Execute(Sql)
            End With
        cnn.Close
    End If
    myfile = Dir()
Loop
Set cnn = Nothing
End Sub

headtrain

魂断蓝桥 发表于 2016-7-21 09:52
Sub 批量复制模板并命名()
Dim mypath$, myfile$
Dim cnn As Object

非常感谢！

[结论$d3:f8]
.[C3:E8] = ""

这些如果要写活的话，怎么写呀？

因为
“源工作簿、源工作表、源区域、本工作簿的目标工作表、目标区域”都是随时变化的。

魂断蓝桥

headtrain 发表于 2016-7-21 10:44
非常感谢！

[结论$d3:f8]

可以根据工作表相关这张表写，

你这个表都是存在的吧

魂断蓝桥

headtrain 发表于 2016-7-21 10:44
非常感谢！

[结论$d3:f8]

Sub a()
Dim mypath$, myfile$, arr, i%
Dim cnn As Object
Dim Sql As String
Set cnn = CreateObject("ADODB.CONNECTION")
arr = Sheet2.[d2].CurrentRegion
mypath = ThisWorkbook.Path & "\"
For i = 2 To UBound(arr)
    cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=NO'; Data Source=" & mypath & arr(i, 1)
    Sql = "select * from [" & arr(i, 2) & "$" & arr(i, 3) & "]"
        With Sheets(arr(i, 4))
            .Range(arr(i, 5)) = ""
            .[c3].CopyFromRecordset cnn.Execute(Sql)
        End With
        cnn.Close
Next
Set cnn = Nothing
End Sub

headtrain

魂断蓝桥 发表于 2016-7-21 11:08
Sub a()
Dim mypath$, myfile$, arr, i%
Dim cnn As Object

不好意思，   麻烦了~
.[c3].CopyFromRecordset cnn.Execute(Sql)
中的C3怎么写活呢？

headtrain

魂断蓝桥 发表于 2016-7-21 11:08
Sub a()
Dim mypath$, myfile$, arr, i%
Dim cnn As Object

已改好，谢谢了！

headtrain

魂断蓝桥 发表于 2016-7-21 11:08
Sub a()
Dim mypath$, myfile$, arr, i%
Dim cnn As Object

真棒！

数据库的写法运行速度非常快，好像源文件都不需要打开，就把数据汇总过来了~

headtrain

魂断蓝桥 发表于 2016-7-21 11:08
Sub a()
Dim mypath$, myfile$, arr, i%
Dim cnn As Object

在实际应用中，还有一个需求与上面的“汇总”反向操作（详见附件）：
点击“复制”按钮，
将本工作簿的源工作表的源区域
复制到目标工作簿的目标工作表的目标区域
（粘贴时采用数值粘贴的方式）


恕本人小白，在上面代码的基础上，怎么改都不对，不知能否再次麻烦DX相助？

非常感谢！！！

魂断蓝桥

headtrain 发表于 2016-7-21 14:01
在实际应用中，还有一个需求与上面的“汇总”反向操作（详见附件）：
点击“复制”按钮，
将本工作簿的 ...

添加，修改对格式的要求高一些，还是用简单的办法吧

Sub a()
Dim arr, mypath$, mybook As Workbook, i%
Set mybook = ThisWorkbook
mypath = ThisWorkbook.Path & "\"
arr = Sheet2.[j2].CurrentRegion
For i = 2 To UBound(arr)
    With Workbooks.Open(mypath & arr(i, 3))
        mybook.Sheets(arr(i, 1)).Range(arr(i, 2)).Copy .Sheets(arr(i, 4)).Range(arr(i, 5))
        .Close True
    End With
Next
End Sub