时间戳

首页 > 解决方案 > 将工作表的选中项粘贴到 VBA Excel 中另一个工作表的彩色单元格

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

问题描述

我有一个VBA Excel程序，当检查了一个单元格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 外观： 表 2

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

这是我的表 1： 表 1

任何帮助将非常感激。

标签： excelvba

解决方案

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

此代码取自此处的讨论。

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

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

推荐阅读