Question

VBA批量修改么指定单元格（帮助修改）

D盘222文件夹下有多份一格式的EXCEL，如何能批量运行代码（下面的一段只能一个一个运行）
Sub 11()
Dim wb As Workbook
Dim HANG As Long
Set wb = ThisWorkbook
HANG = wb.Worksheets("数据录入").Range("J65536").End(xlUp).Row '查找J列最后非空行
For int1 = 1 To HANG
If wb.Worksheets("数据录入").Cells(int1, 10) = 4 Then
wb.Worksheets("物品").Cells(27, 4) = wb.Worksheets("数据录入").Cells(int1, 11)
wb.Worksheets("数据录入").Cells(int1, 10) = 0
wb.Worksheets("数据录入").Cells(int1, 11) = 0
wb.Worksheets("数据录入").Cells(int1, 13) = 0
End If
Next
wb.Save
End Sub

Answer 1

只要表的样式一样，并且提取的单元格位置一样，比如说1000份简历，你要提取姓名、性别等信息，用vba枚举文件夹下的xls文件，后台打开，取数据就行了，很简单，发个样表和要求，我给你写个

Answer 2

试试这个思路：

Sub AutoRepace()
With Application.FileSearch '采用此命令搜索指定目录下的所有工作簿
.FileType = msoFileTypeExcelWorkbooks '设置搜索的文件类型为电子表格型
.LookIn = InputBox("指定工作簿所在目录", , "D:\My Documents")'人工指定搜索的文件夹
.SearchSubFolders = False '不搜索子文件夹
.Execute msoSortByFileName '执行搜索后所得的电子表格文件以文件名排序
If .Execute() > 0 Then '目标文件夹存在电子表格文件
For Each f In .FoundFiles '在所有的工作薄里做一个循环
Application.Workbooks.Open f '逐个打开该目录下工作簿文件
HANG = Worksheets("数据录入").Range("J65536").End(xlUp).Row '查找J列最后非空行
For int1 = 1 To HANG
If Worksheets("数据录入").Cells(int1, 10) = 4 Then
Worksheets("物品").Cells(27, 4) = Worksheets("数据录入").Cells(int1, 11)
Worksheets("数据录入").Cells(int1, 10) = 0
Worksheets("数据录入").Cells(int1, 11) = 0
Worksheets("数据录入").Cells(int1, 13) = 0
End If
Next int1
Application.Workbooks(Workbooks.Count).Save
Application.Workbooks(Workbooks.Count).Close
Next
End If
End With
End Sub

Answer 3

在最外层再加个循环，44看。