在范围内增加值，直到相应的单元格值增加指定量

Question

我有这个问题需要解决。也就是说，我需要将相同值放在范围内的代码，直到相应的单元格值增加一。一旦完成，该值需要增加 0.2 并放置递增的数字，直到相应的单元格值再次高出 1

Sub Button4_Click()


  range1 = Sheets(3).Range("g2").End(xlDown).Row
  range2 = "g2:g" & range1





   For i = 2 To range1

   If Cells(i, 7).Value <= 360 Then

   Cells(i, 8) = 60

   range3_n = Cells(i, 8).Row

   End If
   Next





  j = 0.2
  k = 1
  For i = range3_n To range1



  If Cells(i, 7) > 360 And Cells(i, 7) <= (360 + k) And Cells(i, 7) <= (360 + 
  100) Then

  Cells(i, 8) = 60 + (k * j)
  k = k + 1
  End If
  Next

   MsgBox ("END")    


   End Sub

Answer 1

基于 cmets，并保持代码结构与其完全相同，一个简单的解决方案是在最后一个 IF 语句之后添加一个新的 IF 语句：

IF (Cells(i, 7) - Int(Cells(i, 7)) = 0) Then

代码应如下所示：

Sub Button4_Click()

range1 = Sheets(1).Range("g2").End(xlDown).Row
range2 = "g2:g" & range1

For i = 2 To range1
    If Cells(i, 7).Value <= 360 Then
        Cells(i, 8) = 60
        range3_n = Cells(i, 8).Row
    End If
Next

range3_n = range3_n + 1 'start at cell 361 instead
j = 0.2
k = 1

For i = range3_n To range1
  If Cells(i, 7) > 360 And Cells(i, 7) <= (361 + k) And Cells(i, 7) <= (360 + 100) Then
    If Int(Cells(i - 1, 7)) - Int(Cells(i, 7)) <> 0 Then
        Cells(i, 8) = 60 + (k * j)
        k = k + 1
    Else
        Cells(i, 8) = Cells(i - 1, 8)
        End If
  End If
Next i

MsgBox ("END")

End Sub

它的作用是获取单元格的值，减去该值的整数版本（360.1 = 360、365.4 = 365 等）并确保等于零。任何 > .0 的十进制值都将失败，并且不符合标准。

Example:
360.0 - 360 = 0 PASS
360.1 - 360 = .1 FAIL
360.4 - 360 = .4 FAIL
360.7 - 360 = .7 FAIL
361.0 - 361 = 0 PASS

试试看，然后告诉我。