將工作表的選中項粘貼到 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 循環並發送一條消息，上面寫着“單元格用完”或類似的東西。

這假設彩色單元都是完全相同的顏色。 它還假設行中沒有顏色中斷（即一個連續的顏色塊）。