使用 Excel VBA 更新一系列复选框的列参考

Question

这可能是一个非常简单的问题，但我自己无法将所有内容整合在一起。本质上，我拥有的是一系列复选框，以日历形式表示从 2022 年 4 月到 2022 年 12 月的月份中的几天。每个复选框引用 'calculator' sheet 中的单元格以获得 TRUE/FALSE 值。这是我能够手动设置的，因此它们按顺序从 1 到 275。但是，我有多个 sheet 代表一系列用户——每个用户都有相同的复选框排列。

目前各个checkbox是这样设置的：

=Calculator!$B

该列保持不变，但该行随日期增加。非常简单。

我想做的是使用 Excel VBA 更新列，这样用户 1 将位于 B 列（已设置），用户 2 将位于 C 列，用户 3 将在 D 列等。不幸的是，这是我在 VBA.

的知识上苦苦挣扎的地方

在我看来，主要问题是我组织复选框的方式，传统上很难迭代它们（即，它们不会从单元格 A1 开始，然后向下到单元格 A275） .我的解决方案是使用基本 VBA 脚本简单地将 B 列引用替换为下一列。我找到了一个遍历复选框并尝试将其与 Replace 函数结合使用的方法：

Sub LinkCheck()
    For Each cb In ActiveSheet.CheckBoxes
    cb.LinkedCell = Replace(Formula, "B", "C")
    Next cb
End Sub

当此脚本运行时，它只是删除复选框的内容，而不是更新列值。我已经广泛寻找解决方案，但我发现的大多数答案都比我相当简单的情况复杂得多。

抱歉，如果解决方案非常简单，我仍在努力学习 VBA。

Answer 1

最好的办法是以某种一致的方式重命名您的复选框，这样每个复选框都可以根据其名称与已知行相关联。

您可以使用代码做到这一点：

Dim cb, rw As Long

For Each cb In ActiveSheet.CheckBoxes
    rw = Range(cb.LinkedCell).Row
    Debug.Print cb.Name, rw
    cb.Name = "CbCal_" & Format(rw, "000") 'rename according to linked row
    Debug.Print cb.Name, rw
Next cb

虽然在切换列时您需要做更多的工作 - 否则当前复选框设置将更新新列，而不是新列更新复选框。

Sub Tester()
    SetCheckBoxColumn "E"
    SetCheckBoxColumn "F"
    SetCheckBoxColumn "G"
End Sub

Sub SetCheckBoxColumn(colLetter As String)
    Const WS_NAME As String = "Calculator"
    Dim cb, rw As Long, c As Range, ws As Worksheet
    'probably want to specify a specific sheet and not ActiveSheet...
    For Each cb In ActiveSheet.CheckBoxes
        rw = CLng(Split(cb.Name, "_")(1))                 'using the naming from above...
        Set c = Worksheets(WS_NAME).Cells(rw, colLetter)  'get the linked cell
        cb.LinkedCell = ""                                'unlink the checkbox
        cb.Value = c.Value                                'set the checkbox value to the cell value
        cb.LinkedCell = WS_NAME & "!" & colLetter & rw    'relink the checkbox
    Next cb
End Sub

编辑：经过更多考虑，这个（下面）会更好，因为它不需要重命名复选框并且由任何现有链接单元格的位置驱动.

Sub Tester()
    'SetCheckBoxColumn Sheet3, "E"
    'SetCheckBoxColumn Sheet3, "F"
    SetCheckBoxColumn Sheet3, "G"
End Sub

'Loop over all checkboxes on `wsCB` and adjust linked cell (if set) to
'   Column `ColLetter` on the same row
Sub SetCheckBoxColumn(wsCB As Worksheet, colLetter As String)
    Dim cb, rw As Long, c As Range, ws As Worksheet, lnk
    For Each cb In wsCB.CheckBoxes
        lnk = cb.LinkedCell
        If Len(lnk) > 0 Then
            Set c = Range(lnk)
            cb.LinkedCell = ""
            Set c = c.EntireRow.Columns(colLetter)
            cb.Value = c.Value
            cb.LinkedCell = "'" & c.Parent.Name & "'!" & c.Address
            Debug.Print lnk, cb.LinkedCell
        End If
    Next cb
End Sub

使用 Excel VBA 更新一系列复选框的列参考

Updating Column Reference for Series of Checkboxes Using Excel VBA

checkbox

excel

vba

calendar