Question

我非常感谢您找出有关我的VBA代码错误的任何帮助 - 如果我测试它，电子表格中的数据没有任何反应。

我正在尝试获取具有两个不同电子邮件的行，并将后者拉到新创建的行（If）中的第一个下面，或者删除后者（ElseIf）。

Sub email_List()

a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

    If Worksheets("Sheet1").Cells(i, 3).Value <> Worksheets("Sheet1").Cells(i, 9).Value And IsEmpty(Worksheets("Sheet1").Cells(i, 9)) = False Then
        ActiveCell = Worksheets("Sheet1").Cells(i, 1)
        ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown
        Worksheets("Sheet1").Cells(i, 9).Cut
        Worksheets("Sheet1").Cells(i + 1, 3).Paste

    ElseIf Worksheets("Sheet1").Cells(i, 3).Value = Worksheets("Sheet1").Cells(i, 9).Value Then
        Worksheets("Sheet1").Cells(i, 9).Value.Clear

    End If

Next

Application.CutCopyMode = False

End Sub

Answer 1

这样的东西？

Sub email_List()
    Dim lLastRow As Long
    Dim ws As Worksheet
    Dim i As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

    For i = lLastRow To 2 Step -1

        If ws.Cells(i, 3).Value <> ws.Cells(i, 9).Value And IsEmpty(ws.Cells(i, 9)) = False Then
            ws.Rows(i + 1).EntireRow.Insert Shift:=xlDown
            ws.Cells(i, 9).Cut ws.Cells(i + 1, 3)
        ElseIf ws.Cells(i, 3).Value = ws.Cells(i, 9).Value Then
            ws.Cells(i, 9).ClearContents
        End If
    Next
End Sub

插入行后VBA剪切/粘贴

1 个答案: