首页 > 解决方案 > VBA Excel将多封电子邮件剪切/粘贴到另一个工作表中

问题描述

我正在尝试通过循环将特定数据从一张纸移动到另一张纸。我需要宏来查看电子邮件,然后剪切这些行的所有数据并将它们粘贴到下一个选项卡中。我有以下代码,但我的 .Value = "@" 无法识别。如果我这样做 .Value = "" 那么它会识别所有空白单元格。请帮忙,我知道这可能是超级简单的事情。

Private Sub CommandButton1_Click()
a = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

    If Worksheets("Master").Cells(i, 12).Value = "@" Then
        Worksheets("Master").Rows(i).Cut
        Worksheets("Email").Activate
        b = Worksheets("Email").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Email").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Master").Activate

    End If

Next

Application.CutCopyMode = False

ThisWorkbook.Worksheets("Master").Cells(1,1).Select


End Sub

标签: excelvba

解决方案


好吧,所以这不起作用的原因是因为您在询问 的值Cells(i,12)是否等于@,但我假设您在询问它是否包含字符@。您执行此操作的方法是使用like代替=并将通配符 ( *) 添加到您正在比较的字符串中。所以通配符的作用是他们说任何东西都可以在指定字符的另一边,它会算作匹配。例如@*,将匹配以 开头的任何内容@*@并将匹配以 . 结尾的任何内容@。通过组合它们,您可以获得*@*与包含@.

还需要注意的是,您可以通过直接使用对象而不是激活它们来将其中的大部分内容折叠成一行。

您还应该养成使用Option Explicit和调暗变量的习惯,它可以防止您使用未初始化的变量,这有助于防止较长代码段中的错误。

我在最后添加了一些代码,删除了主工作表使用范围内的所有空白单元格。这将使所有内容都向上移动,因此除非您关心的所有内容都在块中且中间没有空单元格,否则我会将其注释掉。但是,如果您选择使用它,它确实有助于压缩主列表。

Option Explicit

Private Sub CommandButton1_Click()

Dim A as Long
Dim i as Long

A = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
Application.CutCopyMode = False

For i = 2 To A

    If Worksheets("Master").Cells(i, 12).Value Like "*@*" Then
        Worksheets("Master").Rows(i).Copy Destination:= Worksheets("Email").Cells(Worksheets("Email").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
        Worksheets("Master").Rows(i).Clear
    End If

Next

Worksheets("Master").UsedRange.SpecialCells(xlCelltypeBlanks).Delete shift:=xlShiftUp

Application.CutCopyMode = True
End Sub

推荐阅读