如果單元格包含這個或那個粘貼到另一張紙上

Question

我的工作簿SheetJS和Sheet1有 2 張工作SheetJS 。 我有這個代碼部分匹配每行中包含SheetJS的短語“ABC”的單元SheetJS ，並將它們復制到Sheet1 D 列。 它們部分匹配SheetJS中包含短語“123”的單元格，然后復制到Sheet1 G 列。

如何更改代碼以部分匹配Sheet1包含“ABC”或“132”的每一行中的Sheet1格，並將值粘貼到Sheet1 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邏輯。

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

我要求澄清一下，bun 沒有收到任何答復，我將從下一個假設開始：

“Sheet1”的 D:D 列包含 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

最后，它返回出現次數與所做更改的次數。