Применить макрос VBA через различные ячейки?

Изображение SpreadSheet Я создаю трекер Excel для своей работы, который определяет, когда кто-то находится в пределах вторичной и первичной зон, чтобы быть продвинутым до следующего ранга. Я начал с Excel только, но это было слишком ограничено, поэтому я решил попробовать VBA, которого я никогда раньше не использовал. В настоящее время у меня есть сценарий, который читает, что представляет Ранг текущего человека, а затем рассказывает мне о днях, которые они имеют от Даты Ранга, до того дня, когда они будут в первичной или вторичной зонах.

Я могу сделать это только для определенных ячеек, и мне нужно вручную ввести дату их автоматической даты продвижения. Есть ли способ применить один и тот же код по всему листу без необходимости вручную изменять ячейки. Поэтому, если B2 содержит ранг «SPC», тогда F2 будет иметь дни до тех пор, пока индивид в этой строке не будет находиться в первичной зоне для «SGT», и если B3, например, содержит ранг «PFC», тогда F3 будет показывать дни, пока индивидуум находится в Первичной зоне для «SPC» и так далее.

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

Это что-то вроде Макросов. Я не работаю, поэтому я точно не знаю.

Код для самого листа – это что-то вроде

 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 

Я забыл, что еще есть, но он работает только специально для Row 2, и я хотел бы применить его к каждой строке соответственно. B3 & F3, B4 & F4 и т. Д. Другие вещи, которые, я думаю, я могу выяснить самостоятельно, будут автоматически корректировать окончание первичной зоны на основе даты ранжирования, а не делать ее ручной.

Основываясь на коде, который вы указали, было бы проще включить код из 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 

Это предполагает, что лист, на котором существует измененная ячейка, является листом («Лист1»).

Обратите внимание, что Application.EnableEvents отключен до внесения изменений в лист. Это остановит Excel в бесконечном цикле.


Кроме того, вы можете передать измененную ячейку в качестве параметра в 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 

Или еще одним способом было бы просто передать номер строки измененной ячейки в качестве параметра в 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 

Чтобы рассчитать правильную дату (и на основе моего первого метода кодирования), вы можете сделать что-то вроде:

 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 
Давайте будем гением компьютера.