0

我的文件中有什么

Excel 模板

用于存储模板的数据库

这两个文件都是由模板向导创建的

我使用 TW 的目的是因为我必须设计一个交互式表单来发送给其他用户，让他们填写并发送回给我，一旦我进入模板并保存它，它就会自动将其存储到数据库中到目前为止，我在桌面上的一个文件夹中创建了模板和数据库传输效果很好。但我决定做更多。

主要目标

所以我想做的是每次数据库自行更新时，我想使用 worksheet_Change 函数让它自己自动排序。因此，假设它在 C 列显示“是”，我希望它抓取数据库选项卡中的整行并将其转移到“D”选项卡至于“否”，它将转移到“U”选项卡所以我在一个虚拟的 excel 文件上尝试了它，并且复制和粘贴它可以工作。 但是，所以我尝试了原始数据库，关于模板向导的问题是它不是复制粘贴，所以我认为它不像手动复制和粘贴那样工作。

代码

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns("C:C")) Is Nothing Then Exit Sub
    Dim cel As Range
    For Each cel In Intersect(Target, Columns("C:C")).Cells
        If cel.Value = "Yes" Then
            With Sheets("U")
                With .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).EntireRow
                    .Range("A1:I1").Value = Rows(cel.Row).Range("A1:I1").Value
                    .Range("J1:AB1").Value = Rows(cel.Row).Range("AC1:AU1").Value
                    .Range("AC1:AE1").Value = Rows(cel.Row).Range("AV1:AX1").Value
                End With
            End With

        ElseIf cel.Value = "No" Then
            With Sheets("D")
                With .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).EntireRow
                    .Range("A1:AB1").Value = Rows(cel.Row).Range("A1:AB1").Value
                    .Range("AC1:AE1").Value = Rows(cel.Row).Range("AV1:AX1").Value
                End With
            End With
        End If
    Next
End Sub

错误

宏点的错误 With Sheets("U") With Sheets("D")

因此，如果我的表单要填充“是”，则 With Sheets("U") 将突出显示错误

如果我要填充“否”，则 With Sheets(“D”) 将突出显示错误

可能需要将 Worksheet_Change 更改为其他功能.. 但是如何使其更智能和高效？谢谢阅读

4

1 回答 1

0 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns("C:C")) Is Nothing Then Exit Sub
    Dim cel As Range
    Dim rngReceiver As Range
    Dim rngDonor As Range
    For Each cel In Intersect(Target, Columns("C:C")).Cells
      If cel.Value = "Yes" Then
        Set rngReceiver = Sheets("U").Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        rngReceiver.Resize(0, 8).Value = cel.Resize(0, 8).Value '<~ copying A:I, pasting to A1:I1
        rngReceiver.Offset(0, 9).Resize(0, 18).Value = cel.Offset(0, 28).Resize(0, 18).Value '<~copying AC1:AU1 pasting to J1:AB1
        rngReceiver.Offset(0, 28).Resize(0, 2).Value = cel.Offset(0, 47).Resize(0, 2).Value '<~copying AV1:AX1 pasting to AC1:AE1
      ElseIf cel.Value = "No" Then
        Set rngReceiver = Sheets("D").Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).EntireRow
        rngReceiver.Resize(0, 27).Value = cel.Resize(0, 27).Value '<~ copying A1:AB1 pasting to A1:AB1
        rngReceiver.Offset(0, 28).Resize(0, 2).Value = cel.Offset(0, 47).Resize(0, 2).Value '<~ copying AV1:AX1 pasting to AC1:AE1
      End If
    Next
End Sub

未经测试发布此答案。

于 2017-05-18T06:20:49.427 回答