Question

我的文件中包含的内容

Excel模板

用于存储模板的数据库

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

创建的

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

主要目标

所以我想做的是每次数据库自动更新时，我想使用worksheet_Change函数让它自动排序。所以，如果它在C列说“是”，我希望它抓住数据库选项卡中的整行并将其转移到“D”选项卡至于“否”，它会将其转移到“U”标签所以我在一个虚拟excel文件上尝试了它，并且复制和粘贴它的工作原理。但所以我尝试了原始数据库，关于模板向导的事情是它不是复制粘贴所以我认为它的工作原理与我手动复制和粘贴一样。

CODE

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

错误

宏的错误指向两者带表格（“U”）使用表格（“D”）

因此，如果我的表单填写“是”，则表单（“U”）将突出显示错误

如果我填写“否”，With Sheets（“D”）将突出显示错误

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

Answer 1

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

在未经测试的情况下发布此答案。

VBA WorkSheet_Change无法使用模板向导输入

1 个答案: