将工作表的选中项粘贴到 VBA Excel 中另一个工作表的彩色单元格

Question

我有一个VBA ZC1D81AF5835844B4E9D936910DEDED8FDCZ程序，将单元值复制到下一个单元格1的复选框中时，将单元值复制到另一张纸的有色单元格。 现在我的问题是：1。检查各个行的复选框时，它将复制上述单元格的值。（例如，当21个“ n no”“ s”检查框时，它复制了值20）2。当它到达未颜色时，单元格它粘贴一个值并移动到下一行。

  Sub executeCheckBoxes()


    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim chkbx As CheckBox
    Dim i As Long

    Set src = ThisWorkbook.Worksheets("Sheet1")
    Set tgt = ThisWorkbook.Worksheets("Sheet2")
    srcLR = src.Cells(src.Rows.Count, 1).End(xlUp).Row
    tgtER = tgt.Cells(tgt.Rows.Count, 1).Row + 1
    i = 4
    j = 1
    For Each chkbx In src.CheckBoxes
        If chkbx.Value = xlOn Then
        tgt.Cells(i, j).Value = _
            src.Cells(chkbx.TopLeftCell.Row, 1).Value
        tgt.Activate
            If tgt.Cells(i, j).Interior.ColorIndex <> 0 Then
            'tgt.Cells(i, j).Select
             Debug.Print chkbx.Name
             j = j + 1

            Else
             i = i + 1
             j = 1
            End If

         End If
      Next chkbx

End Sub

所以这是我的表 2 外观：

我有 1 到 278 个数字以及“表格 1”中的各个复选框。但我希望它们从左到右复制，并且它也应该根据所选单元格值排列在彩色单元格中。

这是我的表 1：

任何帮助将非常感激。

Answer 1

Function Filled(MyCell As Range)
If MyCell.Interior.ColorIndex > 0 Then
    Result = 1
Else
    Result = ""
End If
Filled = Result
End Function

此代码取自此处的讨论。

使用此 function，您可以编写一个while循环，该循环从单元格1,1开始，然后水平执行，直到到达没有颜色的单元格。 然后它将 go 到下一行。 如果它转到下一行并且单元格没有颜色，那么您可以退出 while 循环并发送一条消息，上面写着“单元格用完”或类似的东西。

这假设彩色单元都是完全相同的颜色。 它还假设行中没有颜色中断（即一个连续的颜色块）。