0

我有这个表充满了数据。每行中的 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 的事情，但我想那是不是很遥远？

4

1 回答 1

2

这是你正在尝试的吗？（经过试验和测试）

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
于 2012-04-20T09:35:53.450 回答