此代码只提取一个单元格内容,
Sub 批量提取字符()Dim myFile, lj, r, c, nr = 2 '指定提取单元格行c = 2 '指定提取单元格列n = 0 book1 = ActiveWorkbook.NameSet objShell = CreateObject("Shell.Application")Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)If objFolder Is Nothing Then MsgBox "未选择文件夹" Exit SubEnd Iflj = objFolder.self.PathIf Right(lj, 1) <> "\" Then lj = lj & "\"End IfSet objFolder = NothingSet objShell = NothingmyFile = Dir(lj & "*.xls")While myFile <> "" Workbooks.Open lj & myFile n = n + 1 Workbooks(book1).Sheets(1).Cells(n, 1).Value = ActiveWorkbook.Sheets("信息表").Cells(r, c).Value '提取指定单元格字符,欲提取多个自行增加代码 ActiveWorkbook.Close 1 myFile = DirWendEnd Sub