0

所以我有一本我一直在设置的工作簿：

工作簿的屏幕截图（其中 2 的单元格是我手动将公式粘贴到该单元格中）

其他带有刚刚计算的公式的屏幕截图，其下方的单元格为空白

  • 基本上，在工作表的一端，我有一个公式来编辑它所在行另一端的单元格的值，具体取决于该行中与目标单元格相邻的单元格中是否有数据。
  • 如果没有数据，它会自动清空目标单元格以及公式单元格下方的单元格。

到目前为止，我已经设法弄清楚了我自己的所有这些，但我无法弄清楚如何实现我接下来想做的事情：

  • 在公式看到该行中有数据并编辑目标单元格后，我还希望它将公式本身复制到其正下方的单元格中（因此确保每行在填写时都具有此功能。）

我一直在尝试在 vba 中构建一个函数来执行此操作，但我很难弄清楚如何执行此操作。我一直在尝试使用 [formulaCell].FormulaLocal 和 PasteSpecial 之类的东西，但是虽然有时我能够成功复制公式，但它总是使用绝对引用或不变的相对引用（即，如果目标单元格在原始公式中是$A2，目标单元格在粘贴公式中仍然是$A2，并且它引用的单元格没有改变。我希望它粘贴为单元​​格$A3，因为它被粘贴到第3行这里。）

这是我在此模块中（以及整个工作簿中）编写的所有自定义代码：

Function CopyCellContents2(copyFrom As Range, CopyTo As Range) ' reference only, I don't use this in the function
copyFrom.Parent.Evaluate "CopyOver2(" & copyFrom.Address(False, False) _ 
                        & "," & CopyTo.Address(False, False) & ")"
CopyCellContents2 = "1"
End Function '  (can you tell i copy-pasted from an online tutorial lol)

Private Sub CopyOver2(copyFrom As Range, CopyTo As Range) ' same as above function
    CopyTo.Value = copyFrom.Value
End Sub

Function CopyFormulaDown(copy__From As Range)  ' This is the function that I can't make work
copy__From.Parent.Evaluate "CopyForm(" & copy__From.Address(False, False) _
                         & ")"
CopyFormulaDown = "1"
End Function

Private Sub CopyForm(copy__From As Range) ' Same as above

startAddress = ActiveCell.Address
ActiveCell.Address = copy__From.Address(False, False)
ActiveCell.Select
Selection.copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Address = startAddress
ActiveCell.Select
Application.CutCopyMode = False

End Sub

Function StaticDate(Copy_To As Range) ' This works well
Copy_To.Parent.Evaluate "CopyDate(" _
                     & Copy_To.Address(False, False) & ")"
StaticDate = "1"
End Function

Private Sub CopyDate(Copy_To As Range) ' Same as above
    Copy_To.Value = Int(Now())
End Sub

Function BlankOtherCell(BlankedCell As Range) ' This also works how I want it to
BlankedCell.Parent.Evaluate "CellBlank(" _
                    & BlankedCell.Address(False, False) & ")"
BlankOtherCell = "1"
End Function

Private Sub CellBlank(BlankedCell As Range) ' Ditto
    BlankedCell.Value = ""
End Sub

公式本身，然后：

=IF(AND(COUNTBLANK($B2:$J2)<9,ISBLANK($A2)),(StaticDate($A2)+CopyFormulaDown($XFD2)),IF(COUNTBLANK($B2:$J2)=9,(BlankOtherCell($A2)+BlankOtherCell($XFD3)),"Date Previously Applied"))

我边走边学，所以我不是专家或任何东西，但我很难找到解决这个问题的方法。这不是我尝试过的损坏功能的唯一迭代，它只是最新的（我在宏记录器中四处乱窜，绝望地想要这个，哈哈）。我想弄清楚这一点，因为每次手动复制粘贴公式都很痛苦，并且将其粘贴到整个列中会使 excel 像我一样上坡（缓慢而糟糕）。任何人都可以在这里给我任何帮助，我将不胜感激，感谢您的阅读！

4

0 回答 0