Скопировать строку данных на основе условного значения «Дата» из листа2 в лист1

Question

Разработка с использованием Excel 2007, но должна быть совместима с 2003.

Проблема:

Книга содержит два листа.Второй лист содержит данные, столбцы от A до M. Столбец C отформатирован для значений даты.Не все строки содержат значение в столбце C.

В Sheet One имеются 3 'кнопки выбора (элемент управления формы), помеченные как Дата контракта, Дата вступления в силу и Дата окончания.Когда выбрана дата контракта, необходимо запросить данные на листе два, столбец C (здесь указана дата) с помощью условного фильтра ... Если дата <сегодняшняя дата + 14 дней ... Если true, скопируйте столбец с C по M изэтот ряд к Листу Один начинается в ячейке C13.Продолжайте до тех пор, пока не будут проверены все строки данных. </p>

Если выбрана другая «Кнопка выбора», результаты первого запроса заменяются результатами второго запроса.

Вот код, над которым я работал, но он не будет работать.

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) <> ""Тогда

   '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

Остальное

Конец, если

Конец, если

Application.ScreenUpdating = True

Конец Sub

Этот пересмотренный код все еще не работает ... не уверен, что это зависает ...

`Sub CopyRowConditional ()

Приложение.ScreenUpDating = False

Srownumber = 2 'номер строки исходного листа "Data_Input"

Trownumber = 13' номер строки целевого листа "Carrier"

Do

Srownumber = Srownumber + 1

Trownumber = Trownumber + 1

If Cells (Srownumber, 3) .Value = "" Тогда выход из Do

If Cells (Srownumber, 4).Value

   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, если вы хотите встретиться лично или на стажировке или если у вас все в порядке с виртуальным.

Надеюсь, это поможет.