Question

我正在制作一个exel模板（待办事项列表），很长一段时间我都被困在最后一期。（这只是模板的一部分）

如果任务完成，我想将状态更改为已完成（通过下拉列表）。

现在，如果Status行中的单元格的值为'Completed'，我希望它将整个表行移动到另一个表中，其中所有已完成的值都是。

有没有人知道这是否可行，如果有，可以了解一下如何？

你会感激不尽，

你的真诚，甲

编辑：

如果单元格有值将行从表移到另一个表

，我已经完成了有关EXCEL的所有操作

现在我希望在我的代码结束时我的表'再次应用排序'。所以已经编写了自定义排序规则，我只想重新排序我的表。

我想到了两个解决方案：

转到表格

执行Ctrl + Alt + l

（这是重新应用当前的排序设置）

在VBA中写入以再次对表进行排序。但是这没有再次编写我的排序规则，因为这是一件非常复杂的事情。我搜索它，自己尝试，但我无法完成它。我已经为第一部分编写了很多代码。一切都已启动并运行，我只需要最后一次修改即可使我的待办事项清单完美无缺。

有人有线索吗？

你诚挚，ASS

Answer 1

以下是我制作解决方案所需的所有代码。我知道它看起来很多，而且可能有一种更简单的方法，但它就是它的本质。如果有任何意见，请随时提出一些建议：）

（这是我第一次使用VBA）

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lstObj As ListObject
    Dim rColumn As Range

    ' get the table reference
    Set lstObj = Worksheets("Daily Task List").ListObjects("TaskList")

    'get the column reference
    Set rColumn = lstObj.ListColumns("Status").DataBodyRange

    'test (display first data value in the column)
    'MsgBox rColumn(1).Value

    If Not Intersect(Target, rColumn) Is Nothing Then MoveMacro (lstObj)
End Sub

事件后的子程序

Public Sub MoveMacro(lstObj)
    'lstObj is the table reference
    If Not IsNull(lstObj) Then

        ResortTable

        If (ActiveCell.Value = "Completed") Then
            Dim SheetToPaste As String
            SheetToPaste = "CompletedSheet"

            'Remember the row that is activated for later
            Dim rng As Range
            Set rng = ActiveSheet.Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 11))

            'Copy the range
            rng.Copy

            'Activate second Worksheet + First cell
            Worksheets(SheetToPaste).Activate
            ActivateFirstBlankCellInTable

            'Paste the row based on the selection (last subroutine)
            Selection.PasteSpecial

            'Ask the user if it wants the range to be deleted
            DeleteFromRow rng

            'ActivateSheet1 again
            Worksheets("Daily Task List").Activate

            'Resort the table
            ResortTable
        End If
    End If
End Sub

激活空白表格中的第一个单元格

Public Sub ActivateFirstBlankCellInTable()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    'loop through each cell untill you find empty cell
    For Each cell In ws.Columns(1).Cells
        If IsEmpty(cell) = True Then cell.Select: Exit For
    Next cell

End Sub

从表中删除范围

Public Sub DeleteFromRow(rng As Range)
    If Not IsNull(rng) Then
        Dim YesOrNoAnswerToMessageBox As String
        Dim QuestionToMessageBox As String

        QuestionToMessageBox = "The row will be copied to this table." & vbNewLine & "Do you want it to be deleted in the other table?"

        'promp a yes no messagebox to ask the user what it wants
        YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "Delete row or not")

        'Catch the reply (only yes necessary
        If YesOrNoAnswerToMessageBox = vbYes Then
             rng.Delete
        End If
    Else
        MsgBox "Error passing range"
    End If
End Sub

度假表（主要代码）

Public Sub ResortTable()
    'Check if cell is in table range
    If IsActiveCellInTable = False Then
        'If not move 1 cell above
        ActiveCell.Offset(0, -1).Select
    End If

    'Execute Sort
    sortExecute
End Sub

检查活动单元格是否在表格中

Function IsActiveCellInTable() As Boolean
    'Function returns true if active cell is in a table and
    'false if it isn't.
    Dim rngActiveCell
    Set rngActiveCell = ActiveCell

    Debug.Print IsActiveCellInTable
    'Test for table.
    'Statement produces error when active cell is not
    'in a table.
    On Error Resume Next
    rngActiveCell = (rngActiveCell.ListObject.Name <> "")
    On Error GoTo 0
    'Set function's return value.
    IsActiveCellInTable = rngActiveCell

End Function

执行排序

Public Sub sortExecute()
    ActiveSheet.ListObjects("TaskList").AutoFilter.ApplyFilter
    With ActiveWorkbook.Worksheets("Daily Task List").ListObjects("TaskList").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

感谢您帮助我入门，感谢您忙于VBA。

问候，

EXCEL如果单元格有值将行从表移动到另一个表

1 个答案: