在变化的单元格上应用VBAmacros?

SpreadSheet的图像我正在为我的工作创build一个Excel跟踪器,以确定何时某个人处于被提升到下一个等级的二级和主要区域内。 我从Excel开始,但是这个太有限了,所以我决定尝试一下以前从未使用过的VBA。 我现在有一个脚本,读取目前的个人排名,然后告诉我他们从排名date到他们将在主要或次要区域的那一天。

我只能为特定单元格执行此操作,而且我必须手动input自动升级date的date。 有没有办法在整个工作表上应用相同的代码,而无需手动更改单元格。 因此,如果B2包含“SPC”的等级,则F2将具有直到该行中的个体具有“SGT”的主要区域的日子,并且如果B3例如包含“PFC”的等级,则F3将显示直到个人处于“SPC”的主要区域的日子等等。

Function Formula() Workbook.Sheets("Sheet1").Range("F2").Formula = "=DATEDIF(""2/24/2017"",Today(),""d"")" End Function 

这就像macros。 我不在工作,所以我无法确定。

工作表本身的代码是类似的

 Sub Workbook_Change(ByVal Target As Range) macroName As String If macroName = "PFC" Then Application.Run Formula() ElseIf macroName = "SPC" Then Application.Run Formula2() EndIf End Sub 

我忘了还有什么,但它只适用于第2行,我想相应地应用到每一行。 B3和F3,B4和F4等。其他的东西,我认为我可以自己计算出来的将自动调整基于排名date的主要区域结束而不是手动。

根据您所显示的代码,将Formula的代码包含在Worksheet_Change事件本身中会更容易,例如

 Sub Worksheet_Change(ByVal Target As Range) Dim macroName As String macroName = "something" If macroName = "PFC" Then Application.EnableEvents = False Cells(Target.Row, "F").Formula = "=DATEDIF(""2/24/2017"",Today(),""d"")" Application.EnableEvents = True ElseIf macroName = "SPC" Then Application.Run Formula2() EndIf End Sub 

这确实假定更改的单元格所在的工作表是Sheets(“Sheet1”)。

请注意,在对工作表进行更改之前,Application.EnableEvents已被禁用。 这将阻止Excel进入无限循环。


或者,您可以将更改的单元格作为parameter passing给Formula

 Function Formula(c As Range) Workbook.Sheets("Sheet1").Cells(c.Row, "F").Formula = "=DATEDIF(""2/24/2017"",Today(),""d"")" End Function Sub Worksheet_Change(ByVal Target As Range) Dim macroName As String macroName = "something" If macroName = "PFC" Then Application.EnableEvents = False Formula Target Application.EnableEvents = True ElseIf macroName = "SPC" Then Formula2 EndIf End Sub 

或者,另一种方法是将更改的单元格的行号作为parameter passing给Formula

 Function Formula(r As Long) Workbook.Sheets("Sheet1").Cells(r, "F").Formula = "=DATEDIF(""2/24/2017"",Today(),""d"")" End Function Sub Worksheet_Change(ByVal Target As Range) Dim macroName As String macroName = "something" If macroName = "PFC" Then Application.EnableEvents = False Formula Target.Row Application.EnableEvents = True ElseIf macroName = "SPC" Then Formula2 EndIf End Sub 

为了计算正确的date(并根据我的第一个编码方法),你可以做一些事情:

 Sub Worksheet_Change(ByVal Target As Range) Dim macroName As String Dim mthsToAdd As Integer Dim apd As Date macroName = "something" If macroName = "PFC" Then Application.EnableEvents = False mthsToAdd = 3 'Note: The following formula won't correctly handle cases such as ' adding two months to 30 December 2016 (it will calculate ' 2 March 2017 in that case, due to "30 February 2017" being ' treated as "2 days after 28 February 2017") Cells(Target.Row, "F").FormulaR1C1 = "=DATEDIF(Today(),DATE(YEAR(RC4),MONTH(RC4)+" & mthsToAdd & ",DAY(RC4)),""d"")" 'or, if your formula doesn't need to allow for future changes to column D apd = DateAdd("m", mthsToAdd, Cells(Target.Row, "D").Value) Cells(Target.Row, "F").FormulaR1C1 = "=DATEDIF(Today(),""" & Format(apd, "mm/dd/yyyy") & """,""d"")" 'or, if you don't even need to allow for future changes to "Today" apd = DateAdd("m", mthsToAdd, Cells(Target.Row, "D").Value) Cells(Target.Row, "F").Value = apd - Date() Application.EnableEvents = True ElseIf macroName = "SPC" Then Application.Run Formula2() EndIf End Sub