用户窗体将数据输入到单独的工作表中。然后,如何使数据外推到两个新行上的另一个工作表?

时间:2019-01-16 15:13:31

标签: excel vba

我创建了一个用户窗体,当我选择命令按钮时会打开该窗体。它的目的是从所选行中获取有关“行程”的数据-即行程代码,开始日期和结束日期,然后让我“拆分”行程,为此我需要输入新的行程代码,开始日期和结束日期。

来自表单的数据进入单独的工作表(称为“拆分”),因此我在一张工作表中记录了原始游览详细信息和新游览详细信息。数据的布局如下:

[A]原始游览代码| [B]原始开始日期| [C]原始结束日期| [D]新游览代码1 | [E]新的开始日期1 | [F]新的结束日期1 | [G]新游览代码2 | [H]新的开始日期2 | [I]新的结束日期2 | [J]分裂的原因

因此,用户窗体会将所有数据插入这些列中-效果很好,我对此感到满意。

然后,我尝试使其复制新游览的详细信息到原始工作表的底部两行(“最终游览”),并从此工作表中删除旧的游览详细信息。但是我不知道如何复制新的游览详细信息(因此“ Splits”工作表上的D:F和G:H),然后删除原始行?

这是我目前的代码:

Object Explicit

    Dim originalRow As Range

Private Sub UserForm_Initialize()
    Set originalRow = ActiveCell.EntireRow
    With Me
        .OriginalTourCode.Value = originalRow.Cells(1).Value
        .OriginalStartDate.Value = originalRow.Cells(2).Value
        .OriginalEndDate.Value = originalRow.Cells(3).Value
    End With
End Sub

Private Sub SplitTourCommand_Click()

    Dim ctrl As Control
    Dim wsSplits As Worksheet
    Set wsSplits = Sheets("Splits")
    Dim wsTours As Worksheet
    Set wsTours = Sheets("Final Tours")
    Dim WSheet As Variant
    Dim DTable As Variant, RowCount As Long

 Application.ActiveWorkbook.Save

    For Each WSheet In ActiveWorkbook.Worksheets
        If wsTours.AutoFilterMode Then
            If wsTours.FilterMode Then
                wsTours.ShowAllData
            End If
        End If
        For Each DTable In wsTours.ListObjects
            If DTable.ShowAutoFilter Then
                DTable.Range.AutoFilter
                DTable.Range.AutoFilter
            End If
        Next DTable
    Next WSheet

    With wsSplits.Cells(Rows.Count, "A").End(xlUp).Row
        With .Offset(2, 0).EntireRow.Row
            .Cells(1) = OriginalTourCode.Text
            .Cells(2) = OriginalStartDate.Text
            .Cells(3) = OriginalEndDate.Text
            .Cells(4) = NewTourCode1.Text
   .Cells(5) = NewStartDate1.Text
    .Cells(6) = NewEndDate1.Text
    .Cells(7) = NewTourCode2.Text
    .Cells(8) = NewStartDate2.Text
    .Cells(9) = NewEndDate2.Text
    .Cells(10) = ReasonForSplit.Text
    .Cells(11).Value = Date

        End With
    End With

    'no need to copy from the Splits sheet since you have the data
    ' in the form fields
    With wsTours.Cells(Rows.Count, "A").End(xlUp)
        .Offset(1, 0).Value = NewTourCode1.Text
        .Offset(1, 1).Value = NewStartDate1.Text
        .Offset(1, 2).Value = NewEndDate1.Text
        .Offset(2, 0).Value = NewTourCode2.Text
        .Offset(2, 1).Value = NewStartDate2.Text
        .Offset(2, 2).Value = NewEndDate2.Text
    End With

    originalRow.Delete 'remove the row the the split tour

    MsgBox "Tour " & wsSplits.Cells(ActiveCell.Row, "A").Value & _
      " has been split to " & wsSplits.Cells(ActiveCell.Row, "D").Value & _
      " and " & wsSplits.Cells(ActiveCell.Row, "G")

End Sub


Private Sub CloseCommand_Click()

Unload Me

End Sub

有什么想法吗?感谢所有帮助。

1 个答案:

答案 0 :(得分:0)

您可以执行以下操作:

Option Explicit

Dim originalRow As Range

Private Sub UserForm_Initialize()
    Set originalRow = ActiveCell.EntireRow '<< store this row in a global variable
    With Me
        .OriginalTourCode.Value = originalRow.Cells(1).Value
        .OriginalStartDate.Value = originalRow.Cells(2).Value
        .OriginalEndDate.Value = originalRow.Cells(3).Value
    End With
End Sub

Private Sub SplitTourCommand_Click()

    Dim ctrl As Control
    Dim wsSplits As Worksheet
    Set wsSplits = Sheets("Splits")
    Dim wsTours As Worksheet
    Set wsTours = Sheets("Final Tours")
    Dim WSheet As Variant
    Dim DTable As Variant, RowCount As Long

    'snipped autofilter code...

    With wsSplits.Cells(Rows.Count, "A").End(xlUp)
        .Offset(1, 0) = workOrderDescription
        With .Offset(2, 0).EntireRow
            .Cells(1) = OriginalTourCode.Text
            .Cells(2) = OriginalStartDate.Text
            .Cells(3) = OriginalEndDate.Text
            'etc etc for the other cells
        End With
    End With

    'no need to copy from the Splits sheet since you have the data
    ' in the form fields
    With wsTours.Cells(Rows.Count, "A").End(xlUp)
        .Offset(1, 0).Value = NewTourCode1.Text
        .Offset(1, 1).Value = NewStartDate1.Text
        .Offset(1, 2).Value = NewEndDate1.Text
        .Offset(2, 0).Value = NewTourCode2.Text
        .Offset(2, 1).Value = NewStartDate2.Text
        .Offset(2, 2).Value = NewEndDate2.Text
    End With

    originalRow.Delete 'remove the row the the split tour

    MsgBox "Tour " & ws.Cells(ActiveCell.Row, "A").Value & _
      " has been split to " & ws.Cells(ActiveCell.Row, "D").Value & _
      " and " & ws.Cells(ActiveCell.Row, "G")

End Sub