Question

我有一份人员名单，其部门的范围从3811-3933。

我试图对所有内容进行排序，以便列表顶部是所有员工，部门编号为3831，直到3843，然后是空白行，然后是其他所有人。由于行以部门顺序出现，因此循环可以在到达部门3844时停止。到目前为止，这是我提出的，但它不起作用。

如果可能的话，我还想把部门3827的行和粘贴在上半部分的底部（3831-3843）

人行从第6行开始，部门在第D列

a = Worksheets("Sheet1").Cells(Rows.Count, 5).End(xlUp).Row

For i = 6 To a
    If Worksheets("Sheet1").Cells(i, 4).Value >= 3831# And 
    Worksheets("Sheet1").Cells(i, 4).Value < 3844# Then
    Worksheets("Sheet1").Rows(i).Cut
    Worksheets("Sheet1").Cells(a + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Sheet1").Rows(i).Delete
    [enter image description here][1]
End If
    Worksheets("Sheet1").Cells(i, 4) = 3844#
Next

 Application.CutCopyMode = False

在玩了SJR的回答之后，我已经提出了这个代码。问题是底部的所有单元都以相反的顺序被切割和粘贴，因此它现在从最小到最小而不是从最小到最大。

a = Worksheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row

With Worksheets("Sheet1")
a = .Cells(Rows.Count, 4).End(xlUp).Row

For i = a To 6 Step -1
    If .Cells(i, 4).Value < 3831# Or .Cells(i, 4).Value >= 3844# Then
        .Rows(i).Cut .Cells(a + 2, 1)
        .Rows(i).Delete
    End If
Next
End With

Answer 1

你可以试试这个，但我仍然不能完全理解你想要做的事情。

Sub x()

With Worksheets("Sheet1")
    a = .Cells(Rows.Count, 5).End(xlUp).Row
    For i = a To 6 Step -1
        If .Cells(i, 4).Value >= 3831# And .Cells(i, 4).Value < 3844# Then
            .Rows(i).Cut .Cells(a + 1, 1)
            .Rows(i).Delete
            .Cells(i, 4) = 3844#
        End If
    Next
End With

End Sub

基于单元格值切割行并在特定行的顶部粘贴

1 个答案: