Question

我使用.find搜索整个工作簿并显示带有匹配超链接的结果。但由于搜索到的单词可以在任何列中找到，我需要知道找到该单词的哪一列才能使搜索结果显示正确。

这是我今天的代码，我使用的是一个稍微修改过的示例：

Sub Set_Hyper()

 '   Object variables
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String
 '   {i} will act as our counter
Dim i As Long
 '   Use an input box to type in the search criteria
Dim MyVal As String

MyVal = ActiveSheet.Range("D9")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

i = 19
 '       Begin looping:
 '       We are checking all the Worksheets in the Workbook
For Each wks In ActiveWorkbook.Worksheets
     If wks.Name <> "Start" Then

     '       We are checking all cells, we don't need the SpecialCells method
     '       the Find method is fast enough
        With wks.Range("A:B")
         '           Using the find method is faster:
         '           Here we are checking column "A" that only have {myVal} explicitly

            Set rCell = .Find(MyVal, , , xlPart, xlByColumns, xlNext, False)
         '           If something is found, then we keep going
            If Not rCell Is Nothing Then
             '               Store the first address
                fFirst = rCell.Address

                Do
                   ' Link to each cell with an occurence of {MyVal}
                    rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Value
                    wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 5)
                    Set rCell = .FindNext(rCell)
                    i = i + 1 'Increment our counter

                    End If

                Loop While Not rCell Is Nothing And rCell.Address <> fFirst
            End If
        End With
     End If
Next wks
 '   Explicitly clear memory
Set rCell = Nothing

    '   Reset application settings
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

我想我想添加这样的东西：

 If rCell.Column() = A Then
        ' Link to each cell with an occurence of {MyVal}
        rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell.Address, TextToDisplay:=rCell.Value
        wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 5)
        Set rCell = .FindNext(rCell)
        i = i + 1 'Increment our counter

 End If

 If rCell.Column() = B Then
        ' Link to each cell with an occurence of {MyVal}
        rCell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rCell(0, -1).Address, TextToDisplay:=rCell(0, -1).Value
        wks.Range("B" & rCell.Row & ":R" & rCell.Row).Copy Destination:=Cells(i, 5)
        Set rCell = .FindNext(rCell)
        i = i + 1 'Increment our counter

 End If

问题是它不能按我想要的方式工作。我试图在某些方面修改它，但要么它似乎只是跳过整个If部分，或者我根本没有得到结果。

我不能以这种方式使用列比较，或者是什么问题？

Answer 1

对Column A使用类似的内容，其中列由其位置（1）而不是字母（A）定义。当您搜索两列范围A:B然后

 If rCell.Column = 1 Then 
 `do code for A
 Else
 `do code for B
 End If

Answer 2

根据您粘贴的代码示例，您可以根据列号直接忽略：

        ' Link to each cell with an occurence of {MyVal}
        rcell.Hyperlinks.Add Cells(i, 4), "", "'" & wks.Name & "'!" & rcell.Offset(, 1 - rcell.Column).Address, TextToDisplay:=rcell.Offset(, 1 - rcell.Column).Value
        wks.Range("B" & rcell.Row & ":R" & rcell.Row).Copy Destination:=Cells(i, 5)
        Set rcell = .FindNext(rcell)
        i = i + 1 'Increment our counter

 End If

确定哪个列.find找到结果

2 个答案: