如果單元格包含某些文本，則復制文本的一部分並移至新表

Question

我試圖使用VBA來檢測包含單詞HELLO的單元格，然后：

取第7至第10個字符，並將其復制到第一行上的新表中

然后將第12個倒數第二個字符復制到新工作表的第二列。

對所有包含該短語的單元格重復此操作。

現在，我無法獲取代碼來復制包含該短語的第一個單元格。

這是當前代碼：

Sub test()
Dim LR As Long, i As Long
With Sheets("Sheet1")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    If .Range("A" & i) Like "*HELLO*" Then
    .Copy Mid(Range("A" & i), 2, 2)

Next i
End Sub

Answer 1

代替復制，最好將部分字符串值分配給第二張工作表的下一個單元格。 我還將UCASE添加到您的if語句中，以防HELLO不大寫。 然后添加一個If，以檢查字符串是否至少為12個字符長，然后再返回第12個字符到最后一個字符。

Sub test()
Dim LR As Long, i2 As Long


LR = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
i2 = 1

For i = 1 To LR
    If UCase(Sheets(1).Range("A" & i).Value) Like "*HELLO*" Then
        Sheets(2).Range("A" & i2).Value = Mid(Sheets(1).Range("A" & i).Value, 7, 3)
        If Len(Sheets(1).Range("A" & i).Value) > 11 Then
            Sheets(2).Range("B" & i2).Value = Mid(Sheets(1).Range("A" & i).Value,13, Len(Sheets(1).Range("A" & i).Value) - 12)
        End If
        i2 = i2 + 1
    End If
Next i

End Sub

Answer 2

您可能無法復制它，您可能只是將其放置在另一個單元格中，例如

Sub Button1_Click()

    Dim LR As Long, i As Long
    With Sheets("Sheet1")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 1 To LR
            If .Range("A" & i) Like "*HELLO*" Then
                Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) = Mid(Range("A" & i), 2, 2)
            End If
        Next i
    End With
End Sub

編輯：啊，其他人也有同樣的想法。