excel 如何将基于值的行移动到另一个工作表?

46scxncf  于 2023-02-25  发布在  其他
关注(0)|答案(1)|浏览(114)

我想根据cStatus中的值查找并移动一行。

  • 如果值为“完成”,则移动到Sheet4。
  • 如果值为“持续”,则移至Sheet2。
  • 如果值为“",则停留在当前工作表。

我的代码不会出现任何错误消息,但它也不会执行代码。
请注意,代码不是我自己的。

Sub MoveBasedOnValue2()

    Dim cStatus As Range, wsDest As Worksheet, Keywords As Range
    Dim Table1 As Range, Table2 As Range
      
    Set cStatus = Sheet1.Range("N2")
    
    If Not cStatus Is Nothing Then
    'Do While Len(cStatus.Value) > 0
        Select Case LCase(cStatus.Value)
            Case "Done": Set wsDest = Sheet4
            Case "On-going": Set wsDest = Sheet2
            Case Else: Set wsDest = Nothing 
        End Select
        
        If Not wsDest Is Nothing Then
               cStatus.EntireRow.Range("A2:N2").Cut _
               Destination:=wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
    End If

    If cStatus Is Nothing Then
        Set cStatus = Sheet1.Range("N1:N1000").Find(what:="Done, On-going")
   
        Do While Len(cStatus.Value) > 0
            Select Case LCase(cStatus.Value)
                Case "done": Set wsDest = Sheet4
                Case "on-going": Set wsDest = Sheet2
                Case Else: Set wsDest = Nothing
            End Select
            
            If Not wsDest Is Nothing Then
                cStatus.EntireRow.Cut _
                Destination:=wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
            End If
        Loop
    End If
End Sub
trnvg8h3

trnvg8h31#

如果您没有移动很多行,那么只需向上扫描工作表,检查相关的单元格值。

Option Explicit

Sub MoveBasedOnValue2()

    Const COL_STATUS = "N"

    Dim wsSrc As Worksheet, wsDest As Worksheet
    Dim lastrow As Long, i As Long, n As Long
    Dim t0 As Single: t0 = Timer
    
    Set wsSrc = Sheet1
    With wsSrc
        lastrow = .Cells(.Rows.Count, COL_STATUS).End(xlUp).Row
        
        For i = lastrow To 1 Step -1
    
            Select Case LCase(Trim(.Cells(i, COL_STATUS)))
               Case "done": Set wsDest = Sheet4
               Case "on-going": Set wsDest = Sheet2
               Case Else: Set wsDest = Nothing
            End Select
        
            If Not wsDest Is Nothing Then
               .Rows(i).Cut _
               Destination:=wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1)
               .Rows(i).Delete
               n = n + 1
            End If
        
        Next
    End With
    MsgBox n & " rows moved", vbInformation, Format(Timer - t0, "0.0 secs")
   
End Sub

相关问题