Флажки и массивы Excel

Question

Я создаю проектный трекер для команды, с которой я работаю, и хочу скопировать всю информацию о проекте для одного проекта в одну строку. Затем 2 столбца в строке будут «Задача выполнена» и «Дата завершена».

В настоящее время я использую список проверки данных, чтобы выбрать «Завершить» в ячейке завершения задачи. Если в списке указано «Завершено», Дата завершения будет автоматически заполнена датой «Сегодня». Я достигаю этого с помощью простых функций в Excel.

Затем я создал код VBA, чтобы щелкнуть командную кнопку, она выделит указанные c ячейки в строке, скопирует эти ячейки, вставит их в пустой лист, затем очистит задачу и дату полные ячейки.

Большинство этих функций работает, но я преодолел препятствие, заставив Excel скопировать данные с чистого листа только в пустые строки (строки A1, A2, A3 и др.) c). Я не уверен, как заставить код копировать данные в пустых строках. Я знаю, что это может быть достигнуто каким-то образом с помощью переменной (I) и циклов.

Другой мой вопрос был, я первоначально хотел использовать флажки вместо проверенного списка, но, кажется, есть проблемы с форматированием с флажками. Если мой размер строки должен измениться, чтобы соответствовать тексту, флажки будут заполнять другие ячейки. Это просто недостаток форм / activeX в Excel или я упускаю часть большей картины?

Я пытался использовать массив для проверки столбца «Задача выполнена», а не отдельные операторы If для добавления даты. Прикрепленный образец моего кода:

Dim pjt As Worksheet
Dim datawks As Worksheet
Dim myBook As Workbook  'define worksheets and workboook
Set myBook = Excel.ActiveWorkbook
Set pjt = myBook.Sheets("Project Tracker")
Set datawks = myBook.Sheets("DATA")

Dim tskarray(16) As String
     tskarray(0) = Range("K4")
     tskarray(1) = Range("k5")
     tskarray(2) = Range("k6")
     tskarray(3) = Range("k7")
     tskarray(4) = Range("k8")
     tskarray(5) = Range("k9")
     tskarray(6) = Range("k10")
     tskarray(7) = Range("k11")
     tskarray(8) = Range("k12")
     tskarray(9) = Range("k13")
     tskarray(10) = Range("k14")
     tskarray(11) = Range("k15")
     tskarray(12) = Range("k16")
     tskarray(13) = Range("k17")
     tskarray(14) = Range("k18")
     tskarray(15) = Range("k19")
     tskarray(16) = Range("k20")


        If tskarray(0) = "Complete" Then
            Range("A4,B4,D4,F4,G4,J4,L4").Select
            Selection.Copy
            datawks.Select
            datawks.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipblanks _
                :=False, Transpose:=False
            Sheets("Project Tracker").Select
            Application.CutCopyMode = False
            pjt.Range("J4,K4").Select
            Selection.ClearContents

        Else
        Debug.Print ("No Task to Complete")
        End If

Answer 1

Так что с помощью всех в этой теме, особенно @Samuel Everson и некоторых друзей дома, я смог заставить свой код работать так, как задумано. Я хотел опубликовать рабочий код для советов по улучшению или для других, которые могут иметь подобные проблемы. Код выглядит следующим образом:

Dim LastRow As Long
Dim LastCol As Long
Dim i As Integer
Dim j As Range


RowCount = 3
ColCount = 3
i = 1
Set j = Range("a1").End(xlDown)

    For ArrayCount = LBound(tskarray) To UBound(tskarray)
        RowCount = RowCount + 1
        ColCount = ColCount + 1

            If tskarray(ArrayCount) = "Complete" Then
                Do While i < 7
                For Each TargetCell In pjt.Range("A" & RowCount & ": L" & RowCount)
                    If TargetCell.Column = 3 Or TargetCell.Column = 5 Or TargetCell.Column = 8 Or TargetCell.Column = 9 Or TargetCell.Column = 11 Then

                    Else

                        With datawks
                         .Range("A1").End(xlUp).Offset(j, i) = TargetCell.Value
                         i = i + 1

                        End With

                    End If

        Next TargetCell
        j = j + 1
        Loop
        i = 1
        'pjt.Range("J" & RowCount & ":K" & RowCount).ClearContents
        End If
        Next ArrayCount

Answer 2

Я полагаю, что это выполнит sh вашу задачу (по крайней мере, по вашему вопросу), если вы не справитесь с упомянутыми вами циклами.

Dim tskarray() As String
ReDim tskarray(0 To 16)
Dim ArrayElementCount As Long
Dim RowCount As Long
RowCount = 3 'this will increment by 1 at the start of the loop so after the last iteration it will end at 16 not 17

For ArrayElementCount = 0 To UBound(tskarray)
    RowCount = RowCount + 1
    tskarray(ArrayElementCount) = pjt.Range("K" & RowCount) 'Assuming on pjt sheet.
Next ArrayElementCount

Dim TargetCell As Range
Dim LastRow As Long
RowCount = 3
For ArrayElementCount = 0 To UBound(tskarray)
    RowCount = RowCount + 1
    If tskarray(ArrayElementCount) = "Complete" Then
        For Each TargetCell In pjt.Range("A" & RowCount & ": L" & RowCount) 'Also assuming on pjt sheet
        If TargetCell.Column = 3 Or TargetCell.Column = 5 Or TargetCell.Column = 8 Or TargetCell.Column = 9 Or TargetCell.Column = 11 Then
                'Ignore columns C, E, H, I and K
            Else
                With datawks
                    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(LastRow, 1).Value = TargetCell.Value
                End With
            End If
        Next TargetCell
        pjt.Range("J" & RowCount & ":K" & RowCount).ClearContents 'Change the column letters if the range should be bigger. 
    Else
        Debug.Print ("No Task to Complete")
    End If
Next ArrayElementCount