VBA - 如果連續有兩個或更多個相同的值時如何調整值？

Question

「我得到了下面的表格，我需要一些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（假設相同範圍的數據）：如果您想更新已在B列的值

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

，而不是把另一個值列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