Question

如果字符串中包含@字符，我试图将单元格值移动到相邻单元格。但是下面的宏没有按预期工作。

Sub Macro1()
  Dim MatchString As String
  MatchString = "@"
  For Counter = 1 To Range("A:A").Count
    If (InStr(Range("A" & Counter).Value, Len(MatchString)) = MatchString) Then
      Range("A" & Counter).Select
      Selection.Cut
      Range("B" & Counter).Select
      ActiveSheet.Paste
    End If
  Next Counter
End Sub

请建议我在这个宏中错过了什么，以便我的程序运行良好。

Answer 1

这应该有用;使用 Like

Sub Macro1()

  With ActiveSheet
  For Counter = 1 To .Range("A:A").Count
    If .Range("A" & Counter).Value Like "*@*" Then

      .Range("A" & Counter).Cut .Range("B" & Counter)
      Application.CutCopyMode = False

    End If
  Next Counter
  End With

End Sub

您应该避免在VBA中选择/激活：

How to avoid using Select in Excel VBA macros

如果您真的不想遍历整个列，请阅读以下内容：

EXCEL VBA - Loop through cells in a column, if not empty, print cell value into another column

正如另一个答案一样，Find对这个问题来说是一个很好的方法（更快）。

Answer 2

而不是查看A列中的每个单元格，只需直接进入具有FIND的单元格。

每次找到@时，它都会移到B列，并删除A列中的值。如果没有找到，循环就会停止。

Public Sub MoveToAdjactent()

    Dim MatchString As String
    Dim rFound As Range

    MatchString = "@"

    With ThisWorkbook.Worksheets("Sheet1").Columns(1)
        Set rFound = .Find(MatchString, LookIn:=xlValues, LookAt:=xlPart)
        If Not rFound Is Nothing Then
            Do
                rFound.Offset(, 1) = rFound
                rFound.ClearContents
                Set rFound = .FindNext(rFound)
            Loop While Not rFound Is Nothing
        End If
    End With

End Sub

宏找不到字符后移动字符串

2 个答案: