Запишите случайное значение в ячейку, если ячейка имеет то же значение, которое можно найти на другом листе

Question

У меня есть два листа ниже в файле Excel. Мне нужен код VBA, который будет записывать в столбце Status значение «Завершено», но только если идентификатор найден в Sheet2. Так, например, в Sheet1 я хочу, чтобы идентификатор 1 был со статусом «Завершено», но идентификатор 2 с пустой ячейкой в ​​статусе, потому что ID2 не может быть найден в листе 2. Я хотел бы сделать это с a для каждого, так как он будет работать быстрее, чем простая формула IF, но я не могу найти код, который бы работал. Спасибо

Sheet1:
----------------------------------
ID |  Product | Date      | Status
-----------------------------------
1  |   abc    | 05-Jan-19 |
2  |   abc    | 07-Jan-18 |
3  |   def    | 05-Apr-19 |
4  |   ghi    | 06-Feb-19 |

Sheet2:
-------------
ID | Product  
-------------
1  | abc       
3  | def     
4  | ghi     

Answer 1

Использовать массив быстро.

Sub setStatus()
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Dim rngDB As Range
    Dim vDB, vR()
    Dim i As Long, n As Long

    Set Ws1 = Sheets(1)
    Set Ws2 = Sheets(2)

    With Ws1
        vDB = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
    End With
    With Ws2
        Set rngDB = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
    End With

    n = UBound(vDB, 1)
    ReDim vR(1 To n, 1 To 1)
    For i = 1 To n
        If WorksheetFunction.CountIf(rngDB, vDB(i, 1)) Then
            vR(i, 1) = "Completed"
        End If
    Next i
    Ws1.Range("d2").Resize(n) = vR
End Sub

Answer 2

Я сделал код с предположением, что оба диапазона начинаются с A1. Пожалуйста, проверьте его!

Sub BringVal()
 Dim sh1 As Worksheet, sh2 As Worksheet, arrCheck As Variant, arrMatch As Variant
 Dim lastRow1 As Long, lastRow2 As Long, i As Long, j As Long, arrRez As Variant
 Dim boolF As Boolean
   Set sh1 = Sheets(1): Set sh2 = Sheets(2) 'use here your real sheets!
   lastRow1 = sh1.Range("A" & sh1.Rows.count).End(xlUp).Row
   lastRow2 = sh2.Range("A" & sh2.Rows.count).End(xlUp).Row

   arrCheck = sh1.Range("A2:A" & lastRow1).Value
   arrMatch = sh2.Range("A2:B" & lastRow2).Value
   ReDim arrRez(1 To UBound(arrCheck))
   For i = 1 To UBound(arrCheck)
        For j = 1 To UBound(arrMatch, 1)
            If arrCheck(i, 1) = arrMatch(j, 1) Then
                boolF = True
                arrRez(i) = arrMatch(j, 2): Exit For
            End If
        Next j
        If Not boolF Then arrRez(i) = Empty
   Next i
   If UBound(arrRez) > 0 _
        Then sh1.Range("D2:D" & UBound(arrRez) + 1).Value = _
        WorksheetFunction.Transpose(arrRez)
End Sub

Код должен быть очень быстрым, так как он работает только в памяти и сбрасывает все собранные данные одновременно. Если вам нужно сообщение для случая, когда не найдено ни одного совпадения, очень просто добавить последовательность Else ... End If после последней If ...

Answer 3

TheReddsable Вы также можете попробовать код ниже

Option Explicit

Dim awb, product_id As String
Dim sht_1_count, sht_2_count, loop_i, loop_d As Double


Sub get_status()

awb = ActiveWorkbook.Name
sht_1_count = Workbooks(awb).Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
sht_2_count = Workbooks(awb).Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row

For loop_i = 2 To sht_1_count

        product_id = Workbooks(awb).Sheets("Sheet1").Cells(loop_i, 1)

    For loop_d = 2 To sht_2_count

        If LCase(Trim(product_id)) = LCase(Trim(Workbooks(awb).Sheets("Sheet2").Cells(loop_d, 1))) Then

            Workbooks(awb).Sheets("Sheet1").Cells(loop_i, 4) = "Completed"
            Exit for
        End If
    Next loop_d

Next loop_i

End Sub

Answer 4

=IF(ISNA(MATCH(A4;Sheet2!$A$2:$A$6;0));"";"Completed")

• A4 - это ячейка в столбце «Состояние» из Sheet1
• $ A $ 2: $ A $ 6 - это диапазон идентификаторов из Sheet2.

Просто примените эта формула для всех ячеек в столбце Статус из Sheet1.