VBA – 如果连续有两个或更多相同的值如何调整值？

“我已经得到了下面的表格，我需要一些VBA的帮助，基本上通过列B循环检查值-1.00是否连续出现两次或更多，以另一个-0.50来调整值。

例如，这里是我的列B和箭头右侧的文本显示了我想要实现的。

-0.50 -1.00 -0.50 -0.50 -1.00 -1.00 --> -1.50 -1.00 --> -2.00 -0.50 -0.50 -0.50 -1.00 -0.50 -1.00 -1.00 --> -1.50 

Answer 1

你不一定需要VBA来执行这个任务，一组简单的嵌套函数就足够了。 假设你的数据在B2中开始，把它放在C2中，然后向下拖动以适应：

 =IF(AND(B2=-1,B1=-1),IF(C1="",B2-0.5,C1-0.5),"") 

但是，如果您确实需要使用VBA（假设数据的范围相同）：

 Option Explicit Public Sub CheckForDuplicates() Dim varRow As Long ThisWorkbook.Sheets("Sheet1").Range("C2:C" & ThisWorkbook.Sheets("Sheet1").Range("C65000").End(xlUp).Row).ClearContents For varRow = 2 To ThisWorkbook.Sheets("Sheet1").Range("B65000").End(xlUp).Row DoEvents If ThisWorkbook.Sheets("Sheet1").Range("B" & varRow).Value = -1 And ThisWorkbook.Sheets("Sheet1").Range("B" & varRow - 1).Value = -1 Then If ThisWorkbook.Sheets("Sheet1").Range("C" & varRow - 1).Value = "" Then ThisWorkbook.Sheets("Sheet1").Range("C" & varRow).Value = ThisWorkbook.Sheets("Sheet1").Range("B" & varRow).Value - 0.5 Else ThisWorkbook.Sheets("Sheet1").Range("C" & varRow).Value = ThisWorkbook.Sheets("Sheet1").Range("C" & varRow - 1).Value - 0.5 End If End If Next End Sub 

Answer 2

如果要更新列B中的值，而不是在列C中放置另一个值

 Sub UpdateDuplicates() Dim sh As Worksheet Dim rw As Range Dim lastval As Double Dim lastvaledit As Double lastval = 0 lastvaledit = 0 Set sh = ActiveSheet For Each rw In sh.Rows If sh.Cells(rw.Row, 2).Value = lastval And sh.Cells(rw.Row, 2).Value = -1 Then lastvaledit = (lastvaledit - 0.5) sh.Cells(rw.Row, 2).Value = lastvaledit Else lastvaledit = -1 lastval = sh.Cells(rw.Row, 2).Value End If If sh.Cells(rw.Row, 2).Value = "" Then GoTo BREAK End If Next rw BREAK: End Sub