Excel 复选框和数组

Question

我正在为与我合作的团队创建一个项目跟踪器，并且我想将单个项目的所有项目信息复制到一行中。然后该行中的 2 列将是“任务完成”和“完成日期”。

目前我正在使用数据验证列表在任务完成单元格中选择“完成”。列出“完成”时，“完成日期”将自动填充“今天”日期。我只是用excel中的简单函数来实现这一点。

然后我创建了 VBA 代码，以便单击命令按钮，它将突出显示行中的特定单元格，复制这些单元格，将它们粘贴到空工作表中，然后清除任务和日期完成单元格。

我已经让这些功能中的大部分都可以使用，但我遇到了障碍，让 excel 仅将空白工作表中的数据复制到空行中（A1、A2、A3 行等）。我不确定如何让代码将数据复制到空行中。我知道它可以通过使用变量（i）和循环来实现。

我的另一个问题是，我最初想使用复选框而不是经过验证的列表，但似乎在使用复选框的格式方面存在问题。如果我的行大小必须更改以适合文本，复选框将挤满其他单元格。这只是 excel 中表单/activeX 的缺陷，还是我错过了大局的一部分？

我尝试使用数组来检查“任务完成”列，而不是使用单独的 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

我相信这将完成您的任务（至少根据您的问题），并结合您提到的循环。

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