Если ячейка содержит ту или иную вставку на другой лист

Question

В моей книге 2 листа SheetJS и Sheet1. У меня есть этот код, который частично соответствует ячейкам в каждой строке, которые содержат фразу «AB C» в SheetJS и копирует их в столбец D в Sheet1. Он частично совпадает с ячейками, содержащими фразу «123» в SheetJS, а затем копируется в столбец G в Sheet1.

Как изменить код, чтобы он частично совпадал с ячейками в каждой строке в Sheet1, содержащей либо "AB C", либо "132", и вставляет значения в столбец D в Sheet1?

Я напишу похожий макрос для копирования значений в столбец G в Sheet1

Sub Extract_Data_or()

    For Each cell In Sheets("SheetJS").Range("A1:ZZ200")

        matchrow = cell.Row

        If cell.Value Like "*ABC*" Then 

            Sheets("Sheet1").Range("D" & matchrow).Value = cell.Value

        ElseIf cell.Value Like "*123*" Then

            Sheets("Sheet1").Range("G" & matchrow).Value = cell.Value

        End If

    Next

End Sub

Любые советы помогут вам!

Answer 1

Использование OR logi c.

Sub Extract_Data_or()
    For Each cel In Sheets("SheetJS").Range("A1:ZZ200")
        matchrow = cel.Row

        If (cel.Value Like "*ABC*") Or (cel.Value Like "*123*") Then
            Sheets("Sheet1").Range("D" & matchrow).Value = cel.Value
        End If
    Next
End Sub

Answer 2

Я попросил дать некоторые разъяснения, но я не получил никакого ответа. Я начну со следующих предположений:

Столбец D: D в «Листе 1» содержит 200 строк, заполненных данными.

Private Sub Extract_Data_or_Arr()
  Dim rngArr As Variant, dArr As Variant
  Dim sh As Worksheet, i As Long, j As Long
  Dim lngOcc As Long, lngChanges As Long, boolFound As Boolean

  Set sh = Sheets("TestOcc")
   rngArr = Sheets("SheetJS").Range("A1:ZZ200").Value
   dArr = sh.Range("D1:D200").Value

    For i = 1 To UBound(rngArr, 1)
        boolFound = False
        For j = 1 To UBound(rngArr, 2)
          If InStr(rngArr(i, j), "ABC") > 0 Or InStr(CStr(rngArr(i, j)), "123") > 0 Then
              If Not boolFound Then lngChanges = lngChanges + 1
              lngOcc = lngOcc + 1: boolFound = True
              dArr(i, 1) = rngArr(i, j)
          End If
       Next j
    Next i
    sh.Range("D1:D200").Value = dArr
    MsgBox lngOcc & " occurrences, vesus " & lngChanges & " changes made."
End Sub

Наконец, он возвращает количество вхождений в зависимости от количества внесенных изменений.