Excel VBAmacros为一列，如果为true，则将公式应用于另一列

对于上下文：

我希望程序能够通过B列查看，在B9单元格中确定第一个“ < / > ”（这是纯粹的文体风格，可以根据需要进行更改 – 仅用于拆分数据）作为一周的开始和B16的下一个“ < / > ”（周末）。 所以我感兴趣的范围是B10-B15 。 然后将这些数字从J10到J15 （获得的列）相加，然后在L16 （Week Total列）中粘贴该总和。 “时间”和“周时间”也是一样的。 在接下来的一周（以及之后），“周末” < / > “成为本周的开始，程序一直持续到B200 。

我没有任何VBA的经验，所以做了以下不完整的尝试（根据我在网上find的），但是我深深地感到不想要求帮助。

 Sub Work() Dim rng As Range Dim rngFound As Range Set rng = Range("B:B") Set rngFound = rng.Find("</>") If rngFound Is "</>" Then If Cell = "</>" Then End If End Sub 

感谢您的帮助，请让我知道，如果我可以更清楚或详细说明一些事情。

Answer 1

下面的代码将循环200行，寻找你的符号。 find时，它将在J列中的当前行和最后一个符号之间的行中求和。

我已经包含了两行更新公式。 对我来说，第二个更容易理解。

 Sub Work() Dim row As Integer row = 4 Dim topRowToAdd As Integer 'Remember which row is the 'top of the next sum topRowToAdd = 4 While row <= 200 If Cells(row, 2) = "</>" Then 'Cells(row, 10).FormulaR1C1 = "=SUM(R[" & -(row - topRowToAdd) & "]C[0]:R[" & -1 & "]C[0])" Cells(row, 10).Value = "=SUM(J" & topRowToAdd & ":J" & row - 1 & ")" topRowToAdd = row + 1 End If row = row + 1 Wend End Sub 

Answer 2

 Sub Work() Dim rng As Range, rngFound As Range Set rng = Range("B:B") Set rngFound = rng.Find("</>") If rngFound.Value2 = "</>" Then 'whatever you want to do End If End Sub 

所以乍一看就像这样。 如果你想使它结构化，你需要首先使用countifs函数。

 Sub Work() Dim rng As Range, rngFound(1) As Range Set rng = Range("B1:B200") On Error GoTo Err 'it is quite possible it will run into an error if there are no matches and I'm too lazy for structured solution Set rngFound(0) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext) 'finds the first Set rngFound(1) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext, After:=rngFound(0)) 'finds the first after the first (ie the second) Set rngFound(0) = rngFound(0).Offset(1, 8) '8 is the difference between B and J, row shifts as per description, I advise you to make it a variable Set rngFound(1) = rngFound(1).Offset(-1, 8) If rngFound(1).Row > rngFound(0).Row Then 'if it's not higher, then it recurred and found the first range again rngFound(1).Offset(1, 2).Formula = "=SUM(" & Range(rngFound(0), rngFound(1)).Address & ")" 'L column will have the sum as a formula Else MsgBox "There is a single match in " & rng.Address(False, False) End If If False Then Err: MsgBox "There are no matches in " & rng.Address(False, False) End If End Sub 

现在为了压轴戏：

 Sub Work() Dim rng As Range, rngFound() As Range, rngdiff(1) As Long, rngcount As Long Set rng = Range("B1:B200") rngcount = rng.Cells.Count ReDim rngFound(rngcount) rngdiff(0) = Range("J1").Column - rng.Column ' the range that needs to be summed is in column J rngdiff(1) = Range("L1").Column - rng.Column ' the range containing the formula is in column L On Error GoTo Err 'it is quite possible it will run into an error if there are no matches and I'm too lazy for structured solution Set rngFound(0) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext) 'finds the first 'loop starts For i = 1 To rngcount Set rngFound(i) = rng.Find(What:="</>", LookAt:=xlWhole, SearchDirection:=xlNext, After:=rngFound(i - 1)) 'finds the next If rngFound(i).Row > rngFound(i - 1).Row Then 'if it's not higher, then it recurred and found the first range again rngFound(i).Offset(0, rngdiff(1)).Formula = "=SUM(" & Range(rngFound(i - 1).Offset(1, rngdiff(0)), rngFound(i).Offset(-1, rngdiff(0))).Address & ")" 'L column will have the sum as a formula Else Exit Sub 'if it recurred the deed is done End If Next i If False Then Err: MsgBox "There are no matches in " & rng.Address(False, False) End If End Sub