SQL与excel根据本文件夹下其他工作簿多个表区域的单列区域查询求和

Admin | 2015-10-6 9:49:10 | 被阅次数 | 4305

温馨提示!

如果未能解决您的问题，请点击搜索；登陆可复制文章，点击登陆

　　根据本文件夹下其他工作簿多个表区域的单列区域查询求和

　　本文件夹下其他工作簿的每个工作簿的第4列 30行查询求和

　　Dim cn As Object, f$, arr&(1 To 30), i%
　　Application.ScreenUpdating = False
　　Set cn = CreateObject("adodb.connection")
　　f = Dir(ThisWorkbook.Path & "\*.xls")
　　Do While f <> ""
　　    If f <> ThisWorkbook.Name Then
　　        cn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no;';data source=" & 　　ThisWorkbook.Path & "\" & f
　　        Range("d5").CopyFromRecordset cn.Execute("select f4 from [基表1$a5:d65536]")
　　       cn.Close

　　       For i = 1 To 30
　　           arr(i) = arr(i) + Range("d" & i + 4)
　　        Next i
　　    End If
　　    f = Dir
　　Loop
　　Range("d5").Resize(UBound(arr), 1) = WorksheetFunction.Transpose(arr)
　　Application.ScreenUpdating = True
　　