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

Question

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

问题：

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

第一页有 3 个选项按钮（表单控件），分别标记为合同日期、生效日期和结束日期。选择合同日期时，需要使用条件过滤器查询第二张表 C 列（此处包含日期）上的数据...如果日期

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

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

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

这就是我对您的问题的想法。见 cmets。您需要将按钮单击绑定到 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。

希望这会有所帮助。