Question

我正在使用代码

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

搜索字符串但我想改变它，以便它在已知的列中搜索最大值，表

如何在vba代码中使用Application.WorksheetFunction.Max或类似代码来使其正常工作？提前谢谢

Answer 1

这应该可以解决问题：

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

如何搜索多个工作簿的最大值

1 个答案: