我编写了一个宏来打开所选文件,搜索发生错误的位置,然后将其放在活动单元格的摘要文件中。它工作得很好但现在我想要而不是逐个选择每个文件我可以一起选择所有需要的文件或者我可以打开一个文件并运行到最后一个文件,因为文件名是串联的,即电机21,电机22和等等。在这篇文章中有一些帮助,但我不知道我是否可以使用它。
Sub InputData()
Dim fNameAndPath As Variant
Dim wb As Workbook, temporaryWB As Workbook
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim SearchString As String, DateCol As String
Dim CumSum As Double, counter As Double, cum As Double
Dim strSheetName As String, CellName As String
Dim lastColumn As Long
Set wb = ThisWorkbook
strSheetName = ActiveSheet.Name
CellName = ActiveCell.Address
cum = Range(CellName).Offset(-1, 2).Value
fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set temporaryWB = Workbooks.Open(fNameAndPath)
Set ws = ActiveSheet
Set oRange = ws.Range("C:C")
SearchString = "10000"
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then ' searching codeID string first time
aCell.Select
DateCol = aCell.Offset(0, -2)
counter = aCell.Offset(0, -1)
wb.Worksheets(strSheetName).Range(CellName) = DateCol
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 1) = counter
CumSum = counter + cum
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 2) = CumSum
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 3) = "1000000"
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 4) = "50"
lastColumn = ws.UsedRange.Columns.Count
If InStr(1, ActiveCell.End(xlToRight).Offset(1, 3).Value, "1ms", vbTextCompare) <> 0 Then
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 6) = ActiveCell.End(xlToRight).Offset(1, 3)
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 7) = ActiveCell.End(xlToRight).Offset(1, 4)
Else
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 6) = Application.InputBox("Enter error", "Dialog box", ActiveCell.End(xlToRight).Offset(1, 3), , , , , 2)
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 7) = Application.InputBox("Enter error", "Dialog box", ActiveCell.End(xlToRight).Offset(1, 4), , , , , 2)
End If
Else
MsgBox SearchString & " not Found"
Exit Sub
End If
temporaryWB.Close savechanges:=False
End Sub
答案 0 :(得分:2)
Application.GetOpenFileName method有一个可选的 multiselect 参数。
使用可能是 False 的返回值或文件名和路径数组(即使该数组是一个文件名/路径的数组)也有点棘手。这是一个可以帮助你入门的框架。
Sub collect_fns()
Dim f As Long, fNameAndPath As Variant
fNameAndPath = Application.GetOpenFilename("Excel files (*.xl*), *.xl*", _
Title:="Select File(s) To Be Opened", MultiSelect:=True)
If IsArray(fNameAndPath) Then
For f = LBound(fNameAndPath) To UBound(fNameAndPath)
' do something with each file as fNameAndPath(f)
process_each_fn CStr(fNameAndPath(f))
Next f
Else
'no files selected
End If
End Sub
Sub process_each_fn(fn As String)
Debug.Print fn
End Sub
如上所示,将大部分代码移动到另一个子代码并将文件名传递给新的子代可能会有所帮助。