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（假设数据范围相同）：

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

VBA - 如果连续两个或更多相同，如何调整值？

2 个答案: