首页 文章

归档第5行vba代码时，将数据剪切到另一张表

提问于
浏览 次
0

我有一个小项目，当工作表1的行大于5时，将数据从工作表1移动到工作表2 .

例如：

表1包含以下数据：

enter image description here

和表2有这样的数据：

enter image description here

当第6行或大于第1页的行时有数据 . 它将数据从第1页的第6行移动到第2页的第一行 .

这样的事情：当工作表1的第6行有数据时（数据在第6行是999）：

enter image description here

在第一行将它切成999到第2页：

enter image description here

我用SheetChange事件尝试了这个 . 这是我的代码

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS1 As Excel.Worksheet
Dim WS2 As Excel.Worksheet
Set WS1 = Workbooks("Book1.xlsm").Worksheets("Sheet1")
Set WS2 = Workbooks("Book1.xlsm").Worksheets("Sheet2")

MaxRow = 5

'find last row of sheet 1 and sheet 2
WS1LastRow = WS1.Cells(WS1.Rows.Count, "A").End(xlUp).Row
WS2LastRow = WS2.Cells(WS2.Rows.Count, "A").End(xlUp).Row

If (Target.Row > MaxRow) Then
    NumberOfRowGreater5 = WS1LastRow - MaxRow
    'move data of sheet 2 down
    WS2.Range("A" & 2 + NumberOfRowGreater5 & ":" & "A" & WS2LastRow + NumberOfRowGreater5).Value = WS2.Range("A2:A" & WS2LastRow).Value
    WS2.Range("A2:A" & 2 + NumberOfRowGreater5 - 1).Clear

    'Cut data from row 5th of sheet 1 to sheet 2
     WS2.Range("A2:A" & 2 + NumberOfRowGreater5 - 1).Value = WS1.Range("A" & MaxRow + 1 & ":" & "A" & WS1LastRow).Value
     WS1.Range("A" & MaxRow + 1 & ":" & "A" & WS1LastRow).Clear
End If

结束子

但有时它会将数据移动错误，有时会重复数据，有时会丢失数据 . 我不知道在没有重复或丢失数据的情况下是否有更好的方法来移动数据 . 我考虑使用vba的Range.Cut函数，但结果相同 .

vba excel-vba macros excel

1 回答

  • 2

    你可以试试这个评论代码

    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MaxRow As Long, ws1LastRow As Long, NumberOfRowGreater5 As Long
    Dim WS2 As Worksheet

    Set WS2 = Workbooks("Book1.xlsm").Worksheets("Sheet2")
    MaxRow = 5

    ws1LastRow = Cells(Rows.count, "A").End(xlUp).row 'find column A last not empty row of current sheet (you're in its own change event handler!)
    If (ws1LastRow > MaxRow) Then '<--| if some values beyond column A row 5
        NumberOfRowGreater5 = ws1LastRow - MaxRow '<--| store rows number to be taken off current sheet and inserted in "Ssheet2"
        Application.EnableEvents = False '<--| disable events not to trigger this event handele in a possibly infinite loop
        On Error GoTo exitsub '<--| be sure to exit this sub properly
        With WS2 '<--| reference "Sheet2"
            With .Range("A2", .Cells(Rows.count, "A").End(xlUp)) '<--| reference its column A cells from row2 down to last not empty one
                .Offset(NumberOfRowGreater5).Value = .Value '<--| shift values down 'NumberOfRowGreater5' rows
            End With
        End With
        With Range("A6").Resize(NumberOfRowGreater5) '<--| reference current sheeet column A range to be "shifted" (i.e. from row 6 down to last not empty one)
            WS2.Range("A2").Resize(NumberOfRowGreater5).Value = .Value '<--| copy its values to "Sheet2" range from row 2 down 'NumberOfRowGreater5' rows
            .ClearContents '<--| clear its content . Here you'd trigger Worksheet_Change() event again hadn't you disabled events
        End With
exitsub:
        Application.EnableEvents = True '<--| enable events back
    End If
End Sub

    实际上，您可以避免 Application.EnableEvents 设置和随后的错误处理，因为 Worksheet_Change() .ClearContents 语句之后的第二次触发 If (ws1LastRow > MaxRow) Then 检查将返回 False

    但要保持良好的编码习惯

    回复于

相关问题