嵌套的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循環，創造行的新範圍在年底被刪除，在一個操作