根据条件“日期”复制一行数据从sheet2到sheet1的值

Question

使用Excel 2007开发，但需要兼容2003。

问题：

工作簿有两张表。第二张表包含数据，从 A 列到 M。C 列的格式设置为日期值。并非所有行都包含 C 列中的值。

表 1 有 3 个选项按钮（表单控件），标记为“合同日期”、“生效日期”和“结束日期”。当选择合同日期时，需要使用条件过滤器查询第二张 C 列（此处包含日期）上的数据...今天的日期 + 14 天...如果为 true，则将该行的 C 列到 M 列复制到第一张工作表的单元格 C13 开始。继续，直到测试完所有数据行。

如果选择另一个“选项按钮”，则第一个查询的结果将替换为第二个查询的结果。

这是我一直在编写的代码，但它不起作用。

Sub OptionButton1_Click()

    Application.ScreenUpdating = False

    TEMPLATE_SHEET = "Data_Input"

    Database_sheet = "Carrier"

    myzerorange = "C" & ActiveWindow.RangeSelection.Row & ":" & "M" & ActiveWindow.RangeSelection.Row

    mycompany = "C" & ActiveWindow.RangeSelection.Row

    mydate = "D" & ActiveWindow.RangeSelection.Row

    Database_sheet = ActiveSheet.Name

    DATABASE_RECORDS = Sheets(Database_sheet).Range("C2:C1000") Count_Row = 13

    If Range(mycompany) <> "" Then

        If Range(mydate) <> "" Then

           'Range(mydate) = contractdate
               If mydate < DateAdd("d", 14, "Today()") Then

                   Range(myzerorange).Copy
                   Sheets(TEMPLATE_SHEET).Select

                   'To identify the next blank row in the database sheet

                   DATABASE_RECORDS = Sheets(TEMPLATE_SHEET).Range("C13:C1000")
                   'To identify the next blank row in the data_Input sheet
                   For Each DBRECORD In DATABASE_RECORDS
                       If DBRECORD <> "" Then
                        Count_Row = Count_Row + 1
                       Next DBRECORD

                   Sheets(TEMPLATE_SHEET).Range("C" & Count_Row).Select
                   ActiveSheet.Paste

                   'Return to origin and check for another contract date
                   Sheets(Database_sheet).Select
               Else

               End If
        Else

        End If

    End If

    Application.ScreenUpdating = True

End Sub

修改后的代码仍然不起作用...不知道是什么挂了这个...

Sub CopyRowConditional()

    Application.ScreenUpdating = False

    Srownumber = 2 'source sheet row number "Data_Input"

    Trownumber = 13 'target sheet row number "Carrier"

    Do

        Srownumber = Srownumber + 1

        Trownumber = Trownumber + 1

        If Cells(Srownumber, 3).Value = "" Then Exit Do

            If Cells(Srownumber, 4).Value < DateAdd("d", 14, "Today()") Then

               For Column = 3 To 13

                   Sheets(template_sheet).Cells(Trownumber, Column).Value = >Sheets(Database_sheet).Cells(Srownumber, Column).Value

               Next Column
            End If

        End If

    Loop

    Application.ScreenUpdating = True

End Sub

Answer 1

这就是我对你的问题的想法。看看评论。您需要将按钮单击绑定到 CopyRowConditional。

Sub CopyRowConditional()

Do

i = i + 1

    If Cells(i, 1).Value = "" Then Exit Do
                    ' this is to exit the loop when you reach an empty row

    If Cells(i, 1).Value = 10 Then ' this is where you put
                    ' the condition that triggers the copy
                    ' here I just put 10 as an example

        TargetRow = 4 ' this is where you need to determine how
                      ' you select the row that will receive the
                      ' data you're copying in the Target sheet
                      ' If you need to check for an empty row
                      ' you can add a Do ... Loop statement
                      ' that stops when the row is good

        For j = 1 To 14 ' this is where you loop in to the
                        'column of the Source sheet

        Sheets("Target").Cells(TargetRow, j).Value = Sheets("Source").Cells(i, j).Value
        ' this is the line that actually does the copying, cell by cell
        ' if you need to change the column index, just write .Cells(i, j+ n).value
        ' where n is any offeset you need


        Next j

    End If

Loop

End Sub

Answer 2

这看起来很容易做到，所以我猜你不太了解 VBA。正如其他人所说，该网站不是为了构建您的应用程序；而是为了帮助您构建应用程序。这是关于构建应用程序的人帮助其他构建应用程序的人。

作为指导，您应该能够在演出网站上发布您的问题，并在几个小时内完成您的项目。如果您想亲自会面或在线会面，或者您可以接受虚拟会议，请尝试 craigslist。

希望这有帮助。