如何search多个工作簿的最大值
即时通讯使用代码
Sub SearchWKBooks() Dim WS As Worksheet Dim myfolder As String Dim Str As String Dim a As Single Dim sht As Worksheet Set WS = Sheets.Add With Application.FileDialog(msoFileDialogFolderPicker) .Show myfolder = .SelectedItems(1) & "\" End With Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2) If Str = "" Then Exit Sub WS.Range("A1") = "Search string:" WS.Range("B1") = Str WS.Range("A2") = "Path:" WS.Range("B2") = myfolder WS.Range("A3") = "Workbook" WS.Range("B3") = "Worksheet" WS.Range("C3") = "Cell Address" WS.Range("D3") = "Link" a = 0 Value = Dir(myfolder) Do Until Value = "" If Value = "." Or Value = ".." Then Else If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then On Error Resume Next Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz" If Err.Number > 0 Then WS.Range("A4").Offset(a, 0).Value = Value WS.Range("B4").Offset(a, 0).Value = "Password protected" a = a + 1 Else On Error GoTo 0 For Each sht In ActiveWorkbook.Worksheets Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext) If Not c Is Nothing Then firstAddress = c.Address Do WS.Range("A4").Offset(a, 0).Value = Value WS.Range("B4").Offset(a, 0).Value = sht.Name WS.Range("C4").Offset(a, 0).Value = c.Address WS.Hyperlinks.Add Anchor:=WS.Range("D4").Offset(a, 0), Address:=myfolder & Value, SubAddress:= _ sht.Name & "!" & c.Address, TextToDisplay:="Link" a = a + 1 Set c = sht.Cells.FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If Next sht End If Workbooks(Value).Close False On Error GoTo 0 End If End If Value = Dir Loop Cells.EntireColumn.AutoFit End Sub search一个string，但我想改变这个，所以它会在一个已知的列，表中search最大值
如何使用Application.WorksheetFunction.Max或类似的VBA代码来使它工作？ 提前致谢
这应该做的伎俩：
Sub SearchWKBooks() Dim wB As Workbook Dim WS As Worksheet Dim myfolder As String Dim Str As String Dim a As Single Dim sht As Worksheet Set WS = Sheets.Add With Application.FileDialog(msoFileDialogFolderPicker) .Show myfolder = .SelectedItems(1) & "\" End With Str = Application.InputBox(prompt:="Search max value in (Sheet/Column):", Title:="Search all workbooks in a folder", Type:=2) If Str = "" Then Exit Sub WS.Range("A1") = "Search max value in (Sheet/Column):" WS.Range("B1") = Str WS.Range("A2") = "Path:" WS.Range("B2") = myfolder WS.Range("A3") = "Workbook" WS.Range("B3") = "Worksheet" WS.Range("C3") = "Max value" WS.Range("D3") = "Link" a = 0 Value = Dir(myfolder) Do Until Value = vbNullString If Value = "." Or Value = ".." Then Else If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then On Error Resume Next Set wB = Workbooks.Open(Filename:=myfolder & Value, Password:="zzzzzzzzzzzz") WS.Range("A4").Offset(a, 0).Value = Value If Err.Number > 0 Then WS.Range("B4").Offset(a, 0).Value = "Password protected" Else On Error GoTo 0 Set sht = wB.Sheets(Split(Str, "/")(0)) WS.Range("B4").Offset(a, 0).Value = sht.Name WS.Range("C4").Offset(a, 0).Value = Application.WorksheetFunction.Max(sht.Columns(Split(Str, "/")(1)).Value) '---------------------------------------------------------- WS.Hyperlinks.Add Anchor:=WS.Range("D4").Offset(a, 0), _ Address:=myfolder & Value, _ SubAddress:=sht.Name & "!" & _ sht.Columns(Split(Str, "/")(1)).Find(WS.Range("C4").Offset(a, 0).Value).Address, _ TextToDisplay:="Link" End If a = a + 1 wB.Close False On Error GoTo 0 End If End If Value = Dir Loop Cells.EntireColumn.AutoFit End Sub