Question

我目前正在Excel中构建一个小型项目规划器，它使用当前日期在日期列下绘制彩色块，以描述我们当前为特定客户所处的项目阶段（见下图）。 p>

Project planner

每个彩色块后面都有一个下拉菜单，该菜单由另一张纸上的列表填充。我的目标是在跟随冻结窗格（由黑色右边框描绘）的所有列中搜索单元格A1中的当前日期（使用today（）填充）。找到当前日期后，应将每个彩色块中的值复制到相应的单元格中，以便在项目进行时，每天输入一行彩色块（使用下拉列表中的相关文本）描绘该块的当前阶段。）

目前我正在使用以下公式复制到冻结后的所有单元格中：

=IF(F$1 = $A$1,$C2,"")

但是，当更改当前日期时，这只会将复制的块移动到相关列，而不会保留前几天的旧值。

我还尝试使用VLOOKUP，以便我可以将其输入宏并从按钮运行，但布局不允许成功的VLOOKUP。

我认为最简单的解决方案是有一个按钮，允许用户使用与当前日期匹配的标题保存列的当前状态，但是自从我在VBA中编码并且不记得以来它已经有一段时间了怎么做。

有什么想法吗？提前致谢。

Answer 1

不确定这是否正是您正在寻找的，但是这里......

Sub ColorCode()
Dim ws As Worksheet
Dim rng As Range
Dim cel As Range

Set ws = ThisWorkbook.Sheets("SheetNameHere")
Set rng = ws.Range("F1:I1")***

For Each cel In rng
    If cel.Value = ws.Range("A1").Value Then
        ws.Range("C2:C8").Copy
        ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteValues
        ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteFormats
    End If
Next

End Sub

如果将其添加到新模块，则可以将其分配给命令按钮。我没有机会测试它，但它会循环显示第一行中的日期，看它们是否与A1中的日期匹配。如果他们这样做，它会复制C2中的值和格式：C8（如果需要，可以更改）到该日期下面的行中。您可能需要更改某些范围以适合您的特定工作表。

Answer 2

所以你的要求对我来说似乎很简单：

您需要跟踪器识别具有今天日期的列
您需要在每天发生永久价值
您需要将今天的颜色值添加到单元格中，并且即使在今天的日期过后也保持这种状态。

您引用问题的公式，如果在所有单元格中复制，显然只会在今天的列上提供一个值，除非您使用循环引用让它自我评估并更新其值在今天的日期，它将在明天到来时保留信息。

如果您希望用户控制更新时间，或者您可以在工作簿打开时或工作表本身被激活时运行代码（将其置于相应的目标代码中），您对按钮的想法就会起作用Private Sub Worksheet_Activate()或Private Sub Workbook_Activate()。

我认为PermaNoob有一个正确的想法，即复制列的值并将值（而不是formlula）粘贴到该列中，但缺少的是适当标识包含今天日期和列的列。那些细胞的着色（如果你没有一些你没有提到的着色方法）。像你建议的那样，这样的东西既可以附加到按钮，也可以按照我的建议附加到_Activate事件。这是未经测试的，但应该让您知道如何处理它：

Sub UpdatePlanner()

    '~~>dim variables and set initial values
        Dim wb As Workbook
            Set wb = Workbooks("NAME or INDEX of YOUR workbook")
        Dim ws As Worksheet
            Set ws = wb.Worksheets("NAME or INDEX of YOUR sheet")
        Dim rngHeader As Range
            Set rngHeader = ws.Range("F1", ws.Range("F1").End(xlToRight))
        Dim rngDate As Range
        Dim rngColumn As Range
        Dim rngCell As Range

    '~~>loop to find the column with today's date
        For Each rngDate In rngHeader
            If rngDate.value = ws.Range("A1").value Then
                Set rngColumn = ws.Range(rngDate.Address, _
                  ws.Range(rngDate.Address).Offset(65536, 0).End(xlUp)) 'this assumes
                    'your column may not have a value in every row
                Exit For
            End If
        Next rngDate

    '~~>copy and paste the column values and formats
        With rngColumn
            .Copy
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With

    '~~>loop to add the color formatting (since I don't see this in your formula)
        For Each rngCell In rngColumn
            If rngCell.value = ws.Range(Cells(rngCell.Row, 3)).value Then
                rngCell.Interior.Color = _
                        ws.Range(Cells(rngCell.Row, 3)).Interior.Color
            End If
        Next rngCell

End Sub

如果行中的列= today（），则复制单元格的内容和格式

2 个答案: