Блог

Я пытаюсь настроить код VBA, который перебирает каждую ячейку в столбце M и возвращает значение столбца L, если ячейка содержит число, и выполняет функцию индексации / сопоставления, если столбец L не содержит числа. Затем, если индекс / совпадение не находит то, что он ищет, он проходит через другой vlookup. У меня возникли проблемы с синтаксисом третьей части этого (vlookup в конце). Я не уверен, должен ли это быть другой оператор Else или оператор if или ISerror или что-то совершенно другое. Прямо сейчас я настроил его как второй if / else. Мне также интересно, будут ли у меня проблемы из-за того, что функция index / match имеет текст в качестве входных данных и должна возвращать число. Любые предложения / советы по этому поводу очень ценятся. Ниже то, что у меня есть до сих пор.

 Sub Ranking_2()

Dim cell As Range, rng As Range
Set rng = Range("L2:L120")

For Each cell In rng
    If WorksheetFunction.IsNumber(cell.Value) Then
        cell.Offset(0, 1).Value = cell.Value
    Else: cell.Offset(0, 1).Value = WorksheetFunction.Index(ThisWorkbook.Sheets(1).Range("K:K"), WorksheetFunction.Match(cell.Offset(0, 1) amp; cell.Offset(0, 5), ThisWorkbook.Sheets(1).Range("A:A") amp; ThisWorkbook.Sheets(1).Range("H:H"), 0))
        If:cell.Offset(0,1).Value= WorksheetFunction.IsError(
        Else: cell.Offset(0, 1).Value = WorksheetFunction.VLookup(cell.Offset(0, -11), ThisWorkbook.Sheets(2).Range("A1:D136"), 3, 0)
End If
Next
End Sub
  

возможно, вы захотите внести эти изменения в свой код

 Option Explicit

Sub Ranking_2()
    Dim cell As Range
    Dim lookUp1Sht As Worksheet
    Dim lookUp2Rng As Range
    Dim val1 As Variant

    Set lookUp1Sht = ThisWorkbook.Worksheets("LookUp1Sht") '<--| set the worksheet you're making the first lookup
    Set lookUp2Rng = ThisWorkbook.Worksheets("LookUp2Sht").Range("A1:C136") '<--| since you're this range returning column "C" value it suffices limiting it to column "C"

    For Each cell In Range("L2:L120").SpecialCells(xlCellTypeConstants) '<--| limit looping through wanted range not blank cells only
        With cell '<--| reference current cell
            Select Case True
                Case IsNumeric(.Value) '<--| if current cell value can be evaluated as "number"... 
                    .Offset(0, 1).Value = CDbl(.Value)
                Case Not IsError(LookUp1(lookUp1Sht, .Offset(0, 1).Value, .Offset(0, 5).Value, val1)) '<-- if "first" lookup doesn't return an "error"...
                    .Offset(0, 1).Value = val1 '<--| then write the 3rd argument passed from LookUp1() function
                Case Else '<-- if all preceeding "cases" failed...
                    .Offset(0, 1).Value = Application.VLookup(.Offset(0, -11), lookUp2Rng, 3, 0) '<-- write "second" lookup return value
            End Select
        End With
    Next
End Sub

Function LookUp1(sht As Worksheet, val1 As Variant, val2 As Variant, val As Variant) As Variant
    Dim f As Range
    Dim firstAddress As String

    With sht '<--| reference passed worksheet
        Set f = .Range("A:A").Find(what:=val1, LookIn:=xlValues, lookat:=xlWhole) '<-- look for first passed value in its column "A"
        If Not f Is Nothing Then '<--| if found...
            firstAddress = f.Address '<--| store found cell address to stop subsequent FindNext() loop upon wrapping back to it
            Do '<--| loop
                If f.Offset(, 7).Value = val2 Then '<--| if corresponding value in column "H" matches val2...
                    val = .Cells(f.row, "K") '<-- set 3rd argument to value in column "K" corresponding to the "double" match
                    Exit Function '<--| exit function
                End If
                Set f = .Range("A:A").FindNext(f) '<-- go on looking for val1 in column "A"
            Loop While f.Address <> firstAddress '<-- stop looping upon wrapping back on first cell found
        End If
    End With
    LookUp1 = CVErr(xlErrValue) '<-- if no "double" match occurred then return "#VALUE!" error
End Function
  

пожалуйста, обратите внимание, что:

• измените «LookUp1Sht» и «LookUp2Sht» на ваши фактические имена рабочих листов

• Match и LookUp Application функции обрабатывают возможные ошибки без остановки макроса и просто возвращают значение ошибки

  Это я использовал только в .Offset(0, 1).Value = Application.VLookup(.Offset(0, -11)... , так что, если «поиск последнего шанса» когда-либо вернет ошибку, она будет записана в вашей .Offset(0,1) ячейке

• используйте SpecialCells() метод для возврата отфильтрованной группы диапазона, для которого вы ее вызываете: например, используя xlCellTypeConstants в качестве Type параметра, вы получите обратно не только пустую ячейку

• используйте IsNumeric() функцию вместо [ WorksheetFunction.IsNumber() [(https://msdn.microsoft.com/en-us/library/office/ff840818 (v= office.15).aspx), поскольку первый распознает строку «5» как число, в то время как второй не будет