如何把一个工作簿中的值填到多个工作簿的工作表中

zhaogang1960 · 发表于 2012-5-9 17:10

yah760911 发表于 2012-5-9 17:02
显示:执行阶段错误,不正确的档案名称与数目,这是怎么回事啊?

估计是字段名不统一，请上传有问题的附件分析一下

zhaogang1960 · 发表于 2012-5-9 17:09

改进一下，只连接第一个工作簿以加快速度：

Sub Macro1()
Dim cnn As Object, cat As Object, tb1 As Object
Dim SQL$, s$, t$, arr, i&, n&, MyPath$, MyFile$
arr = [a1].CurrentRegion
Set cnn = CreateObject("adodb.connection")
Set cat = CreateObject("ADOX.Catalog")
MyPath = ThisWorkbook.Path & "\表"
MyFile = Dir(MyPath & "*.xls")
Do While MyFile <> ""
n = n + 1
If n = 1 Then cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=excel 8.0;Data Source=" & MyPath & MyFile
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & MyPath & MyFile
For Each tb1 In cat.Tables
If tb1.Type = "TABLE" Then
s = Replace(tb1.Name, "'", "")
If Right(s, 1) = "$" Then
If n > 1 Then t = "[Excel 8.0;Database=" & MyPath & MyFile & "].[" & s & "]" Else t = "[" & s & "]"
For i = 2 To UBound(arr)
SQL = "update " & t & " set 子件規格='" & arr(i, 3) & "',基本用量=" & arr(i, 5) & ",子件顏色='" & arr(i, 6) & "' where 子件編碼='" & arr(i, 1) & "'" '只取第一个条件
cnn.Execute SQL
Next
End If
End If
Next
MyFile = Dir()
Loop
cnn.Close
Set cnn = Nothing
Set cat = Nothing
Set tb1 = Nothing
MsgBox "更新完毕"
End Sub

复制代码

yah760911 · 发表于 2012-5-9 17:02

显示:执行阶段错误,不正确的档案名称与数目,这是怎么回事啊?

zhaogang1960 · 发表于 2012-5-9 16:47

请看附件

测试.rar (33.19 KB, 下载次数: 24)

zhaogang1960 · 发表于 2012-5-9 16:46

Sub Macro1()
Dim cnn As Object, cat As Object, tb1 As Object
Dim SQL$, s$, arr, i&, MyPath$, MyFile$
arr = [a1].CurrentRegion
Set cat = CreateObject("ADOX.Catalog")
MyPath = ThisWorkbook.Path & "\表"
MyFile = Dir(MyPath & "*.xls")
Do While MyFile <> ""
Set cnn = CreateObject("adodb.connection")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=excel 8.0;Data Source=" & MyPath & MyFile
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & MyPath & MyFile
For Each tb1 In cat.Tables
If tb1.Type = "TABLE" Then
s = Replace(tb1.Name, "'", "")
If Right(s, 1) = "$" Then
For i = 2 To UBound(arr)
SQL = "update [" & s & "] set 子件規格='" & arr(i, 3) & "',基本用量=" & arr(i, 5) & ",子件顏色='" & arr(i, 6) & "' where 子件編碼='" & arr(i, 1) & "'" '只取第一个条件
cnn.Execute SQL
Next
End If
End If
Next
MyFile = Dir()
Loop
cnn.Close
Set cnn = Nothing
Set cat = Nothing
Set tb1 = Nothing
End Sub

复制代码

yah760911 · 发表于 2012-5-8 14:30

更新工作表里的值

zhaogang1960 · 发表于 2012-5-8 16:41

yah760911 发表于 2012-5-8 14:30
更新工作表里的值

1、3个需要更新的工作簿我打不开
2、说说你更新的规则，模拟效果(更新前、更新后)

yah760911 · 发表于 2012-5-8 17:31

VBA将这个工作表里的编码,名称,规格,单位,用量,颜色A2:F3更新
对应到"表"工作簿里的所有工作表中,如果不需要或没有的不动,保留以前的数据

yah760911 · 发表于 2012-5-8 17:33

工序行號級別子件行號子件編碼子件名稱子件規格子件計量單位基本用量子件顏色
1 10 PDN-JHK-5423N 木板1 200*120*10mm 個 1 本色
2 20 PDN-JHK-5424N 木板2 220*120*10mm 個 1 本色
3 30 PDN-JHK-5425N 木板3 230*120*11mm 個 1 本色
4 40 PDN-JHK-5426N 木板4 240*120*11mm 個 1 本色
5 50 PDN-JHK-5427N 木板5 250*120*12mm 個 1 本色

yah760911 · 发表于 2012-5-8 17:34

以上这是更新前的值

		自动登录	找回密码
密码			免费注册

[求助] 如何把一个工作簿中的值填到多个工作簿的工作表中

评分