请高手帮忙弄一下代码，后台操作多个工作簿数据汇总及修改保存

zhang880113

将“水电费查询”工作簿中的数据汇总修改变为从文件夹“电费”中的工作簿汇总修改数据，要求全部从后台运行。求各位老师帮帮忙！

zhang880113

求大侠们帮帮忙，谢谢了。

zhang880113

求大侠们帮帮忙，谢谢了。

zhang880113

求大侠们帮帮忙，谢谢了。

gaohong267

Sub 号码查询()
Sheets(1).Range("a9:" & "y" & Cells(Rows.Count, 2).End(3).Row + 1) = ""
Application.ScreenUpdating = False
   
     Dim sh As Worksheet
     Dim Cn As Object
    Dim Rs As Object
    Set Cn = CreateObject("ADODB.Connection")
    Set Rs = CreateObject("ADODB.Recordset")
    Cn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0';data source=" & ThisWorkbook.FullName
   
    For Each sh In ThisWorkbook.Worksheets
       If sh.Name <> "查询表" Then
   
     
     
      
     Sql = "select *    from [" & sh.Name & "$]a where  a.商铺号码 = " & Sheets("查询表").Cells(4, 2) & " "
     
    i = Sheets("查询表").Range("b1048576").End(3).Row + 1
     
     
      
     Sheets("查询表").Range("b" & i).CopyFromRecordset Cn.Execute(Sql)
     r = Sheets("查询表").Range("b1048576").End(3).Row
     Sheets("查询表").Range("a" & i & ":a" & r) = sh.Name
        
     End If
        
    Next
   
    Set Rs = Nothing
    Set Cn = Nothing
Application.ScreenUpdating = True

End Sub

gaohong267

搜索  同文件夹    下  查询
Sub 号码查询()
Sheets(1).Range("a9:" & "y" & Cells(Rows.Count, 2).End(3).Row + 1) = ""
Application.ScreenUpdating = False
   
     Dim sh As Worksheet
     Dim Cn As Object
    Dim Rs As Object
    Set Cn = CreateObject("ADODB.Connection")
    Set Rs = CreateObject("ADODB.Recordset")
    Cn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0';data source=" & ThisWorkbook.FullName
   
   MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.xls")
    Do While MyName <> ""
        
        If MyName <> ThisWorkbook.Name Then
            With GetObject(MyPath & MyName)
            
                For Each sh In .Sheets
                   If sh.Name <> "查询表" Then
     Sql = "select *    from [" & sh.Name & "$]a where  a.商铺号码 = " & Sheets("查询表").Cells(4, 2) & " "
     
    i = Sheets("查询表").Range("b1048576").End(3).Row + 1
     
     Sheets("查询表").Range("b" & i).CopyFromRecordset Cn.Execute(Sql)
     r = Sheets("查询表").Range("b1048576").End(3).Row
     Sheets("查询表").Range("a" & i & ":a" & r) = sh.Name
     End If
    Next
    Set Rs = Nothing
    Set Cn = Nothing
               
                .Close False
            End With
        End If
        MyName = Dir
    Loop
  
Application.ScreenUpdating = True

End Sub

zhang880113

gaohong267 发表于 2016-4-13 13:56
搜索  同文件夹    下  查询
Sub 号码查询()
Sheets(1).Range("a9:" & "y" & Cells(Rows.Count, 2).End(3 ...

Sheets("查询表").Range("b" & i).CopyFromRecordset Cn.Execute(Sql)老师你好同文件夹查询的时候这一句会出错，

zhang880113

求帮忙，，，，，，

lzqmsy

zhang880113 发表于 2016-4-13 22:56
求帮忙，，，，，，

不是有人回复你了吗?现在还有什么问题,需要帮你做什么?

zhang880113

lzqmsy 发表于 2016-4-14 04:41
不是有人回复你了吗?现在还有什么问题,需要帮你做什么?

老师你好，我在水电费查询表中设计一个在本工作簿中查询数据的一个模版，里面有四个按钮可实现查询和更新修改，因为后面还有很多数据，我想在后台操作从其他工作簿中取数并更新修改，这一块我不会。请老师帮下忙。谢谢！