Question

我的这张桌子里装满了数据。并且每行中的列K包含一个数字。所以基本上我要做的就是将整行（如果该列中的数据大于9）移到sheet2。

如何实现这一目标？我已经在工作表中创建了实际的表，称为Table1和Table2。

到目前为止，这是我设法整理的内容。我看过自动过滤器，但是我无法理解那里发生了什么。所以我得到了！

Sub MoveData()

    Dim i As Range
    Dim num As Integer
     num = 1
    For Each i In Range("K10:K1000")
        If i.Value > 9 Then
            i.Select
            ActiveCell.Rows("1:1").EntireRow.Select
            Selection.Copy

            Sheets("Sheet2").Range("A65000").End(xlUp).Offset(num, 0).PasteSpecial
            ActiveCell.Rows.Delete
            num = num + 1

        End If
    Next i
End Sub

到目前为止这种方法有效。但我无法将行粘贴到sheet2中的下一个空行。我试着做那个num = num + 1的东西，但我猜这还不行？

Answer 1

这是你在尝试什么？（已审判并已经过测试）

Option Explicit

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim rRange As Range

    Dim lastRowWsO As Long

    Set wsI = Sheets("sheet1")

    '~~> Assuming that the Header is in K10
    Set rRange = wsI.Range("K10:K1000")

    Set wsO = Sheets("sheet2")

    '~~> Get next empty cell in Sheet2
    lastRowWsO = wsO.Range("A" & Rows.Count).End(xlUp).Row + 1

    With wsI
        '~~> Remove Auto Filter if any
        .AutoFilterMode = False

        With rRange
            '~~> Set the Filter
            .AutoFilter Field:=1, Criteria1:=">=9"

            '~~> Temporarirly hide the unwanted rows
            wsI.Rows("1:9").EntireRow.Hidden = True
            wsI.Rows("1001:" & Rows.Count).EntireRow.Hidden = True

            '~~> Copy the Filtered rows
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            wsO.Rows(lastRowWsO)

            '~~> Delete The filtered rows
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        '~~> Unhide the rows
        .Rows("1:9").EntireRow.Hidden = False
        .Rows("1001:" & Rows.Count).EntireRow.Hidden = False

        '~~> Remove Auto Filter
        .AutoFilterMode = False
    End With
End Sub

注意：我没有包含任何错误处理。我建议你在最终代码中加入一个

<强>后续

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim rRange As Range

    Dim lastRowWsI As Long, lastRowWsO As Long

    Set wsI = Sheets("Risikoanalyse")

    '~~> Assuming that the Header is in K10
    Set rRange = wsI.Range("K9:K1000")

    lastRowWsI = wsI.Cells.Find(What:="*", _
                After:=wsI.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row


    Set wsO = Sheets("SJA utarbeides")

    '~~> Get next empty cell in Sheet2
    lastRowWsO = wsO.Cells.Find(What:="*", _
                After:=wsO.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row + 1

    With wsI
        With .ListObjects("TableRisikoAnalyse")
            '~~> Set the Filter
            .Range.AutoFilter Field:=11, Criteria1:=">=9"

            '~~> Temporarirly hide the unwanted rows
            wsI.Rows("1:8").EntireRow.Hidden = True
            wsI.Rows(lastRowWsI & ":" & Rows.Count).EntireRow.Hidden = True

            '~~> Copy the Filtered rows
            wsI.Range(Replace(wsI.Range("K9").Offset(1, 0).SpecialCells(xlCellTypeVisible).Address, "$9:$9,", "")).EntireRow.Copy _
            wsO.Rows(lastRowWsO)

            '~~> Clear The filtered rows
            wsI.Range(Replace(wsI.Range("K9").Offset(1, 0).SpecialCells(xlCellTypeVisible).Address, "$9:$9,", "")).Clear

            .Range.AutoFilter Field:=11

            '~~> Sort the table so that blank cells are pushed down                
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("TableRisikoAnalyse[[ ]]"), SortOn:=xlSortOnValues, Order _
            :=xlAscending, DataOption:=xlSortTextAsNumbers
            With .Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With

        '~~> Unhide the rows
        .Rows("1:8").EntireRow.Hidden = False
        .Rows(lastRowWsI & ":" & Rows.Count).EntireRow.Hidden = False

        '~~> Remove Auto Filter
        .AutoFilterMode = False
    End With
End Sub

Excel Vba - 如果单元格中的值大于，则复制行

1 个答案: