批量修改文件夹下多个EXCEL表中的内容

笑忘の书

大家好，不成材的小弟又要来求助了，最近工作中遇到一个问题，文件夹中有几千个表，每个表中A列为名称，B列为单价，现在想把每个表中A列值为“AAA”对应的B列的数量统一修改一下：例如表a中A6的值为"AAA"那么把B6的值改为“100”，表b中A7的值为"AAA"那么把B7的值改为“100”，表c中A15的值为"AAA"那么把B15的值改为“100”，请问有没有什么简便的方法能够把该文件夹下所有的表都完成替换处理（如果原来做过总的汇总表那么用VLOOKUP只要在汇总表里面改一下就行，但是因为有的表里有公式有的没有公式所以要一个个改会非常麻烦）我在网上查了一下做了一个效果不是很好，处理起来也挺慢的，只能厚颜上来求助大家，谢谢！上个附件 新建文件夹.zip (22.18 KB, 下载次数: 170)

2013-11-4 14:14 上传

点击文件名下载附件

，再次感谢！
可能我表达能力太差所以还是上个图吧
上图中A7的值为“AAA”，我想对应把B7的值改为“100"，其他的表以此类推，把所有文件夹里的表都这样改一下

笑忘の书

自己顶一下，别沉底。。。再次求助

zhaogang1960

几千个工作簿建议使用ADO法实现更新，否则仅打开工作簿这个动作就要很长时间：

1. Sub replace()
   
2.     Dim myDialog As FileDialog, oFile As Object
   
3.     Dim FSO, myFolder As Object, myFiles As Object
   
4.     Dim fn$, cnn As Object, m&, SQL$
   
5.     Set FSO = CreateObject("Scripting.FileSystemObject")
   
6.     Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)
   
7.     With myDialog
   
8.         If .Show <> -1 Then Exit Sub
   
9.         Set myFolder = FSO.GetFolder(.InitialFileName)
   
10.         Set myFiles = myFolder.Files
    
11.         For Each oFile In myFiles
    
12.             If oFile.Name <> ThisWorkbook.Name Then
    
13.                 m = m + 1
    
14.                 If m = 1 Then
    
15.                     Set cnn = CreateObject("adodb.connection")
    
16.                     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & oFile
    
17.                     SQL = "update [Sheet1$] set 单价=100 where 名称='AAA'"
    
18.                 Else
    
19.                     SQL = "update [Excel 8.0;Database=" & oFile & "].[Sheet1$] set 单价=100 where 名称='AAA'"
    
20.                 End If
    
21.                 cnn.Execute SQL
    
22.             End If
    
23.         Next
    
24.         If m > 0 Then
    
25.             MsgBox "文件处理完成"
    
26.             cnn.Close
    
27.             Set cnn = Nothing
    
28.         Else
    
29.             MsgBox "没有发现可更新的文件"
    
30.         End If
    
31.     End With
    
32. End Sub
    

复制代码

zhaogang1960

请看附件
新建文件夹.rar (22.13 KB, 下载次数: 635)

2013-11-4 15:35 上传

点击文件名下载附件

笑忘の书

zhaogang1960 发表于 2013-11-4 15:34
几千个工作簿建议使用ADO法实现更新，否则仅打开工作簿这个动作就要很长时间：

对对，就是打开关闭慢的要死，多谢版主，这个方法挺简单的，谢谢！！

笑忘の书

zhaogang1960 发表于 2013-11-4 15:34
几千个工作簿建议使用ADO法实现更新，否则仅打开工作簿这个动作就要很长时间：

你好版主
If oFile.Name <> ThisWorkbook.Name Then
                m = m + 1
                If m = 1 Then
                    Set cnn = CreateObject("adodb.connection")
                    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & oFile
                    SQL = "update [Sheet1$] set 单价=100 where 名称='AAA'"
                Else
                    SQL = "update [Excel 8.0;Database=" & oFile & "].[Sheet1$] set 单价=100 where 名称='AAA'"
                End If
                cnn.Execute SQL
            End If
请问这段语句有什么用，是创建一个数据库链接然后在数据库里面更新吗一下就行了吗？
我是半路出家对这些不是很懂，不满足只知道结果希望能搞清楚原理，希望老师再给我讲解下吧，谢谢啦

zhaogang1960

笑忘の书 发表于 2013-11-4 15:59
你好版主
If oFile.Name  ThisWorkbook.Name Then
                m = m + 1

把工作簿作为数据库更新
需要更新的工作簿太多，全部连接可能会影响速度，就连接第一个工作簿l，其他采用非连接状态更新

笑忘の书

zhaogang1960 发表于 2013-11-4 16:29
把工作簿作为数据库更新
需要更新的工作簿太多，全部连接可能会影响速度，就连接第一个工作簿l，其他采用 ...

是不是所有的格式必须要一致，有不一样格式的文件在里面会弹出运行时错误“-2147217904（80040e10）”：至少一个参数没有被指定，
调试时“cnn.Execute SQL”这段代码无法运行

zhaogang1960

笑忘の书 发表于 2013-11-5 10:56
是不是所有的格式必须要一致，有不一样格式的文件在里面会弹出运行时错误“-2147217904（80040e10）”：至 ...

所有的格式必须要一致，如果仅是标题行不一致，还可以修改程序

笑忘の书

zhaogang1960 发表于 2013-11-5 11:51
所有的格式必须要一致，如果仅是标题行不一致，还可以修改程序

终于搞定了，里面的表千奇百怪的格式都有只能一步步测试再找出不符合格式的表修改，看来统一格式还是很有必要。谢谢版主热心指导，又学会一招。万分感谢！