Сравните значение в ячейке с массивом, а затем добавьте значение, если оно истинно

Question

Я все еще немного новичок в VBA и работаю над созданием своих собственных макросов и тому подобным.Но у меня есть небольшая проблема с небольшим количеством кода.

У меня есть журнал, в который я записываю информацию о поставщике, и на рабочем листе у меня есть этот код ниже, который ищет значение, введенное в него посредством ввода номера, и затем проверяет, связано ли имя сэто из другого листа, содержащего таблицу имен.

Приведенный ниже код работает нормально по большей части, однако мне было трудно заставить его искать также, если введенное значение уже было введеновыше или ниже этого.В настоящее время, когда вводится число, оно извлекает имя и затем добавляет значение 1 к соответствующей ячейке по найденному результату на листе, содержащем список имен.

Конечный результат, который я пытаюсьчтобы добиться этого, нужно, чтобы он проверял, существует ли имя на текущем рабочем листе (а не на листе со списком имен), и, если это так, не добавит значение 1 на лист, содержащий все мои имена и номера.

Я пытался использовать цикл, но не смог заставить его работать.Любая помощь будет принята с благодарностью!

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("B6:B37", "B46:B77")) Is Nothing Then

If WorksheetFunction.IsNumber(Target.Value) Then

   Application.EnableEvents = False

   Vendor = Sheet8.Range("A2:B500")
   Target.Value = Application.VLookup(Target.Value, Vendor, 2, False)

   Application.EnableEvents = True

   Set StartValue = ThisWorkbook.Sheets("Vendor List").Range("A:B").Find(What:=Target.Value, LookIn:=xlValues)
   cPos = StartValue.Address

   Set ThisValue = ThisWorkbook.Sheets("Wednesday").Range("B6:B77").Find(What:=Target.Value, _
            After:=Target.Value, _
            LookIn:=xlValues, _
            LookAt:=xlPart, _
            SearchDirection:=xlNext, _
            MatchCase:=True, _
            SearchFormat:=False)

   ThisWorkbook.Sheets("Vendor List").Range(cPos).Offset(0, 8).Value = ThisWorkbook.Sheets("Vendor List").Range(cPos).Offset(0, 8).Value + 1

End If

If IsError(Target.Value) Then

    Target.Value = ""
    MsgBox "The Vendor number entered is not listed. Either you have entered an invalid number, or you have not yet added this vendor to the Vendor List sheet.", vbCritical
    ThisWorkbook.Sheets("Vendor List").Range(cPos).Offset(0, 8).Value = ThisWorkbook.Sheets("Vendor List").Range(cPos).Offset(0, 8).Value - 1

End If

End If

Я прикрепил изображение того, как это работает.Надеюсь, это немного прояснится ...

Пример

Answer 1

Не проверено:

Private Sub Worksheet_Change(ByVal Target As Range)
    Const RNG_VENDOR As String = "B6:B37,B46:B77"

    Dim v, f As Range, vendor, vendorCount

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Range(RNG_VENDOR)) Is Nothing Then Exit Sub

    v = Target.Value
    If IsNumeric(v) And Len(v) > 0 Then

       'see if there's a numeric match
       Set f = Sheet8.Range("A:A").Find(v, lookat:=xlWhole, LookIn:=xlValues)
       If Not f Is Nothing Then
            vendor = f.EntireRow.Cells(1, "B").Value 'get the vendor name
            '#### edit below to fix lookup range
            vendorCount = Application.CountIf(Me.Range("B6:B77"), vendor) 'count any existing
            'update the vendors sheet?
            With f.EntireRow.Cells(1, "J")
                If vendorCount = 0 Then .Value = .Value + 1
            End With
            Application.EnableEvents = False
            Target.Value = vendor 'switch from vendor number to vendor name
            Application.EnableEvents = True

       Else
            Application.EnableEvents = False
            Target.Value = ""   'clear the value
            Application.EnableEvents = True
            MsgBox "The Vendor number '" & v & "' entered is not listed....", vbExclamation
       End If   'was found
    End If      'is a number

End Sub