Найти / оценить 2 диапазона в листе А перед вставкой значения в лист Б

Question

Я получаю:

Ошибка несоответствия, время выполнения 13

Sub Lookup()

For Each Cell In Workbooks("ID.xlsx").Worksheets("ID").Range("B:B")

If Range("B:B").Cells.Value = "RM" Then

End If

Next

For Each Cell In Workbooks("ID.xlsx").Worksheets("ID")

If Range("C:C").Cells.Value = "Sales $" Then

Workbooks("ABC_Actuals and Targets.xlsm").Worksheets("ID").Cells(9, 7).Value = Workbooks("ID.xlsx").Worksheets("ID").Range("BM:BM").Value

End If

Next

End Sub

Я намерен сделать Excel l oop через ячейки в диапазонах в B: B Ws Source, если True, то L oop через ячейки в диапазонах C: C от Ws Source, если True, то Скопировать значение этой строки в столбце BL из Ws Source Вставить значение в обозначенную Ws целевую ячейку (9 , 7).

В Ws Source много столбцов. Пример: с Ws Source: найдите RM в столбце B, затем найдите Sales $ в столбце C, если эти 2 равны true, скопируйте значение в columnn BL этой строки и вставьте PasteValue в ячейки (9, 7) в Ws Destination .

В Ws Source есть 43 "RM" столбца B и 58 "Sales $" в столбце C. Строка уникальна, когда встречается «RM» в столбце B и «Sales $» в Ws Source.

Что я намерен установить для значения Destination Wbk.Cell (9,7) для столбца BL этого уникального Ws Источник, упомянутый выше.

Answer 1

Вы можете попробовать:

Option Explicit

Sub test()

    Dim wsS As Worksheet, wsD As Worksheet
    Dim LastRow As Long, i As Long
    Dim arr As Variant

    'Set the workbooks
    Set wsS = Workbooks("ID.xlsx").Worksheets("ID")
    Set wsD = Workbooks("ABC_Actuals and Targets.xlsm").Worksheets("ID")

    With wsS
        'Find the last row of column B to avoid looping all column
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        'Import the values in an array to be more fast
        arr = .Range("A1:C" & LastRow)
        'Loop array
        For i = LBound(arr) To UBound(arr)
            'If both conditions met
            If arr(i, 1) = "RM" And arr(i, 2) = "Sales $" Then
                'Import in the destination workbook the value of column C
                With wsD
                    .Cells(9, 7).Value = arr(i, 3)
                End With

            End If

        Next i

    End With

End Sub

Answer 2

это будет AutoFilter работа, но вот возможное Find() soultion:

Sub LookupTest()
    Dim f As Range
    Dim firstAddress As String

    With Workbooks("ID.xlsx").Worksheets("ID")
        With .Range("B1", .Cells(.Rows.Count, 2).End(xlUp))
            Set f = .Find(what:="RM", LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                firstAddress = f.Address
                Do
                    If f.Offset(, 1).Value = "Sales $" Then
                        Workbooks("ABC_Actuals and Targets.xlsm").Worksheets("ID").Cells(9, 7).Value = .Cells(f.Row, "BL").Value
                        MsgBox "Done"
                        Exit Sub
                    End If
                    Set f = .FindNext(f)
                Loop While f.Address <> firstAddress
            End If
        End With
    End With
    MsgBox "No such match!"
End Sub

Изменить, чтобы добавить решение на основе AutofIlter:

    With Workbooks("ID.xlsx").Worksheets("ID")
        With .Range("C1", .Cells(.Rows.Count, 2).End(xlUp))
            .AutoFilter field:=1, Criteria1:="RM"
            .AutoFilter field:=2, Criteria1:="Sales $"
            Workbooks("ABC_Actuals and Targets.xlsm").Worksheets("ID").Cells(9, 7).Value = _
                .Parent.Cells(.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Areas(1).Rows(1).Row, "BL").Value
        End With
        .AutoFilterMode = False
    End With

и где предполагается, что совпадение всегда найдено

Answer 3

Приведенный ниже код является верным толкованием того, что вы объяснили выше Пожалуйста, попробуйте это. Также обратите внимание на комментарии. Они помогут вам понять, как логи c встроены в VBA.

Option Explicit

Sub Lookup_DoSomething()            ' "Lookup" is the name of an Excel function

    ' always declare all your variables, especially the objects!
    '   Use Option Explicit to help you

    Dim WsS As Worksheet            ' Source sheet
    Dim WsD As Worksheet            ' Destination sheet
    Dim Cell As Range

    ' Note: both workbooks must be open or an error will occur
    Set WsS = Workbooks("ID.xlsx").Worksheets("ID")
    Set WsD = Workbooks("ABC_Actuals and Targets.xlsm").Worksheets("ID")

    ' use proper indenting to help you read your code
    '   and better understand its logic
    For Each Cell In Ws.Range("B:B")
        ' 'Cell.Offset(0, 1)' is in column C
        If Cell.Value = "RM" And Cell.Offset(0, 1).Value = "Sales $" Then
            WsD.Cells(9, 7).Value = WsS.Cells(Cell.Row, "BL").Value
            ' I think you need to end the loop when the value was found
            ' if you don't do that the loop will continue writing to
            ' the same cell and you get to see only the last one found.
            Exit For
        End If
    Next Cell                       ' always specify which "Next"
End Sub