如果单元格包含某些文本复制部分文本并移动到新工作表

时间:2015-08-10 20:46:55

标签: excel vba excel-vba

我试图使用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

2 个答案:

答案 0 :(得分:1)

最好将部分字符串值分配到第二个工作表中的下一个单元格,而不是复制。如果HELLO没有资本化,我还在你的if语句中添加了UCASE。然后在返回第12个到最后一个字符之前添加一个If以检查该字符串是否至少为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

答案 1 :(得分:0)

你可能无法复制它,你可能只是把它放在另一个像

这样的单元格位置
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

编辑: 啊,其他人有同样的想法。