Кнопка Excel VBA go в ячейку после полной находки - PullRequest
0 голосов
/ 31 января 2020

Я создаю превосходный список книг для нашей библиотеки и использую пользовательскую форму для вставки новой записи сведений о книгах. После того, как пользователь введет детали в пользовательскую форму, я хотел бы проверить три элемента из (ISBNTextBox.Text, TitleTextBox.Text, CallNoTextBox.Text), если книга уже существует в нашем списке, чтобы избежать дублирования списка. Затем, если дубликат найден, мы можем проверить дубликаты данных, нажав кнопку и наведя указатель на ячейку любых трех данных выше. Ниже приведен код, который я уже пробовал, но не работает. Может кто-нибудь помочь мне это исправить?

ОБНОВЛЕНИЕ: Опробовано одно из этих решений для комментариев, оно работает, но только для ISBN (столбец E), для заголовка и номера вызова, когда щелчок указывает только на ячейку B1

Private Sub Gotobutton_Click()

    Dim oRange As Range, aCell As Range, bCell As Range
    Dim ws As Worksheet
    Dim ExitLoop As Boolean
    Dim SearchString As Variant, FoundAt As String

    ''On Error GoTo Whoa

    Set ws = Worksheets("booklist")
    Set oRange = ws.Range("B:B, E:E, F:F")

    SearchString = Array(ISBNTextBox.Text, TitleTextBox.Text, CallNoTextBox.Text)

    Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        Set bCell = aCell
        FoundAt = aCell.Address
        Do While ExitLoop = False
            Set aCell = oRange.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                FoundAt = FoundAt & ", " & aCell.Address
            Else
                ExitLoop = True
            End If
        Loop
    End If

    ''MsgBox "The Search String has been found these locations: " & FoundAt
    Application.GoTo Worksheets("booklist").Range(FoundAt)
    Exit Sub
''Whoa:
    MsgBox Err.Description
End Sub

Дайте мне знать, если вам нужен файл xlsm.

Excel list sample

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...