嵌套的If语句将行剪切和粘贴到不同的工作表

Question

有人可以帮助使用此代码吗？

我在比较两个工作簿。我已经构建了一个For循环来检查工作簿1中的唯一ID是否与工作簿2中的ID匹配。 如果它们匹配，我将返回的行＃赋给变量lrow。然后我需要检查C列中的返回行的值。 根据lrow中的值，C列需要剪切工作簿1，工作表1中的行并粘贴到工作簿1中的不同工作表。我也 需要删除被切割的行，所以我没有空白行时完成。

我收到嵌套Else If语句的语法错误。它们都以红色突出显示。我还在 这些行上写上“必须是行中的第一条语句”的编译错误。

你能让我知道我在嵌套if缺少什么，并验证我的剪切和粘贴操作是否有效。

感谢您的协助。

Option Explicit 

Sub Complete() 

Dim Lastrow, Newrow As Long 
Dim i, lrow As Long 
Dim wb1, wb2 As Workbook 
Dim ws1, ws2 As Worksheet 

' Turn off notifications 

Application.ScreenUpdating = False 

Workbooks.OpenText Filename:="C:\workbook2.xlsx" 
Set wb1 = ThisWorkbook 
Set wb2 = Workbooks("workbook2.xlsx") 
Set ws1 = wb1.Worksheets("Sheet1") 
Set ws2 = wb2.Worksheets("Sheet1") 

With wb1.Worksheets(ws1) 

    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 
    For i = 2 To Lastrow 

    If Not IsError(Application.Match(.Cells(i, "G").Value, ws2.Columns("A"), 0)) Then 

     lrow = Application.Match(.Cells(i, "G").Value, ws2.Columns("A"), 0) 

     If ws2.Cells(lrow,"C") = 18 Then 

      Newrow = wb1.Worksheets("Sheet3").Range("A1").End(xlDown).Row + 1 
      ws1.Cells(i,"G").EntireRow.Cut wb1.Worksheets("Sheet3").Cells(newrow,"A") 
      ws1.Cells(i,"G").EntireRow.Delete 

     ElseIf ws2.Cells(lrow,"C") = 23 Then 

      Newrow = wb1.Worksheets("Sheet4").Range("A1").End(xlDown).Row + 1 
      ws1.Cells(i,"G").EntireRow.Cut wb1.Worksheets("Sheet4").Cells(newrow,"A") 
      ws1.Cells(i,"G").EntireRow.Delete 

     ElseIf ws2.Cells(lrow,"C") = 24 Then 

      Newrow = wb1.Worksheets("Sheet4").Range("A1").End(xlDown).Row + 1 
      ws1.Cells(i,"G").EntireRow.Cut wb1.Worksheets("Sheet4").Cells(newrow,"A") 
      ws1.Cells(i,"G").EntireRow.Delete 

     ElseIf ws2.Cells(lrow,"C") = 36 Then 

      Newrow = wb1.Worksheets("Sheet5").Range("A1").End(xlDown).Row + 1 
      ws1.Cells(i,"G").EntireRow.Cut wb1.Worksheets("Sheet5").Cells(newrow,"A") 
      ws1.Cells(i,"G").EntireRow.Delete 

     End If 
    End If 
    Next i 
End With 

Workbooks("workbook2.xlsx").Close savechanges:=False 

' Turn on notifications 
Application.ScreenUpdating = True 

' Message Box showing that process is complete. 

    MsgBox "Done!" 

End Sub 

Answer 1

从最后的评论我做出@paulbica我纠正了行改为：

If Not IsError(Application.Match(.Cells(i, "G").Value, ws2.Columns("A"), 0)) Then 

代码现在运行正常。我已更新帖子以反映所做的更改。

谢谢。

Answer 2

这是很好的，你解决了这个类型不匹配的错误，但也有几个遗留问题

线由于工作表函数将表名或索引作为参数，并WS1 With wb1.Worksheets(ws1)会引发另一种类型不匹配错误是一个工作表对象，所以它应该更改为With wb1.Worksheets(ws1.Name)或简单地With ws1

这样实现的循环会跳过行，如果它们是连续的。例如，如果您从总共5行开始，则需要移动所有行，在第一次迭代中，我是2，第2行将被删除。下一个迭代行3在删除后成为第2行，但是我现在是3，所以最初的第3行被跳过并且处理移动到当前第3行，这以前是4

取决于您的代码有多少数据是相当很慢，因为它经常与范围相互作用。例如，它为每个If分支提取值ws2.Cells(lrow,"C")，提取每个剪切操作的表3,4和5中的最后一行，并在当时删除一行

这就是我如何编写代码：

---

Option Explicit 

Public Sub Complete() 
    Dim i As Long, toDel As Range, copyCell As Range 
    Dim ws11 As Worksheet, ws13 As Worksheet, ws14 As Worksheet, ws15 As Worksheet 
    Dim ws13LR As Long, ws14LR As Long, ws15LR As Long 
    Dim wb2 As Workbook, ws21 As Worksheet, wb2row As Variant, wb2colA As Variant 

    Application.ScreenUpdating = False 
    Workbooks.OpenText Filename:="C:\workbook2.xlsx" 
    Set wb2 = Workbooks("workbook2.xlsx") 
    Set ws11 = Sheet1 

    Set ws13 = Sheet3:   ws13LR = ws13.Cells(ws13.Rows.Count, 1).End(xlUp).Row + 1 
    Set ws14 = Sheet4:   ws14LR = ws14.Cells(ws14.Rows.Count, 1).End(xlUp).Row + 1 
    Set ws15 = Sheet5:   ws15LR = ws15.Cells(ws15.Rows.Count, 1).End(xlUp).Row + 1 
    Set ws21 = wb2.Sheets(1): wb2colA = ws21.UsedRange.Columns("A").Value2 

    For i = 2 To ws11.Cells(ws11.Rows.Count, 1).End(xlUp).Row + 1 
     wb2row = Application.Match(ws11.UsedRange.Cells(i, "G").Value, wb2colA, 0) 
     If Not IsError(wb2row) Then 
      Set copyCell = Nothing 
      Select Case ws21.Cells(wb2row, "C").Value2 
       Case 18:  Set copyCell = ws13.Cells(ws13LR, "A"): ws13LR = ws13LR + 1 
       Case 23, 24: Set copyCell = ws14.Cells(ws14LR, "A"): ws14LR = ws14LR + 1 
       Case 36:  Set copyCell = ws15.Cells(ws15LR, "A"): ws15LR = ws15LR + 1 
      End Select 
      If Not copyCell Is Nothing Then 
       With ws11.UsedRange 
        .Rows(i).EntireRow.Copy copyCell 
        If toDel Is Nothing Then 
         Set toDel = .Rows(i) 
        Else 
         Set toDel = Union(toDel, .Rows(i)) 
        End If 
       End With 
      End If 
     End If 
    Next i 
    wb2.Close False 
    toDel.EntireRow.Delete 
    Application.ScreenUpdating = True 
    MsgBox "Done!" 
End Sub 

---

我感动了所有不必要的操作出了For循环，创造行的新范围在年底被删除，在一个操作