Я использую .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, либо я вообще не получаю результата.

Разве я не могу использовать сравнение столбцов таким образом, или в чем проблема?

1
andysando 9 Июн 2014 в 11:42

2 ответа

Лучший ответ

Используйте что-то подобное для Column A, где столбец определяется его позицией (1) , а не буквой (A) . При поиске в диапазоне из двух столбцов A:B, тогда

 If rCell.Column = 1 Then 
 `do code for A
 Else
 `do code for B
 End If
0
brettdj 9 Июн 2014 в 07:49

Судя по вставленному вами образцу кода, кажется, что вы можете просто смещать непосредственно на основе номера столбца:

        ' 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
0
Rory 9 Июн 2014 в 07:58