[已解决]公式VBA化

sunche

老师们，晚上好！初学写代码，运行后发现有一处代码没有运行（sheet1中黄色列），自己找不出问题所在，请老师们帮忙！谢谢！

最佳答案

月排行榜 / 总排行榜

hasyh2008

2022-6-2 15:58

Sub test()
  Application.StatusBar = False
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Dim r As Long, i As Long, t As Single
  t = Timer
  With Sheet1
      r = .[a65536].End(xlUp).Row
      For i = 4 To r
          grrq = Int(Application.WorksheetFunctin.Days360(Range("p" & i), Range("r2")) / 30)
          .Cells(i, 19) = Round(.Cells(i, 17) * .Cells(i, 18), 2)
          .Cells(i, 21) = Round(.Cells(i, 20) * 12, 2)
          .Cells(i, 22) = IIf(grrq >= Cells(i, 21), Cells(i, 21), grrq)
          .Cells(i, 23) = Round((Cells(i, 18) - Cells(i, 19)) / Cells(i, 21), 0)
          If Int(grrq / 30) = Cells(i, 21) Then
             .Cells(i, 24) = .Cells(i, 18) - .Cells(i, 19) - .Cells(i, 23) * (.Cells(i, 21) - 1)
          Else
             If grrq > .Cells(i, 21) Then
                .Cells(i, 24) = "已折旧完"
             Else
                If .Cells(i, 22) <= 0 Then
                   .Cells(i, 25) = 0
                Else
                   .Cells(i, 24) = .Cells(i, 23)
                End If
             End If
             If grrq >= .Cells(i, 21) Then
                .Cells(i, 25) = .Cells(i, 18) - .Cells(i, 19)
             ElseIf .Cells(i, 24) = "本月不提" Then
                .Cells(i, 25) = 0
             Else
                .Cells(i, 25) = .Cells(i, 22) * .Cells(i, 24)
             End If
          End If
        .Cells(i, 26) = .Cells(i, 18) - .Cells(i, 25)
      Next i
  End With
  Application.StatusBar = True
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , ""
End Sub

跳转到最佳答案楼层

hasyh2008

Sub test()
  Application.StatusBar = False
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Dim r As Long, i As Long, t As Single
  t = Timer
  With Sheet1
      r = .[a65536].End(xlUp).Row
      For i = 4 To r
          grrq = Int(Application.WorksheetFunctin.Days360(Range("p" & i), Range("r2")) / 30)
          .Cells(i, 19) = Round(.Cells(i, 17) * .Cells(i, 18), 2)
          .Cells(i, 21) = Round(.Cells(i, 20) * 12, 2)
          .Cells(i, 22) = IIf(grrq >= Cells(i, 21), Cells(i, 21), grrq)
          .Cells(i, 23) = Round((Cells(i, 18) - Cells(i, 19)) / Cells(i, 21), 0)
          If Int(grrq / 30) = Cells(i, 21) Then
             .Cells(i, 24) = .Cells(i, 18) - .Cells(i, 19) - .Cells(i, 23) * (.Cells(i, 21) - 1)
          Else
             If grrq > .Cells(i, 21) Then
                .Cells(i, 24) = "已折旧完"
             Else
                If .Cells(i, 22) <= 0 Then
                   .Cells(i, 25) = 0
                Else
                   .Cells(i, 24) = .Cells(i, 23)
                End If
             End If
             If grrq >= .Cells(i, 21) Then
                .Cells(i, 25) = .Cells(i, 18) - .Cells(i, 19)
             ElseIf .Cells(i, 24) = "本月不提" Then
                .Cells(i, 25) = 0
             Else
                .Cells(i, 25) = .Cells(i, 22) * .Cells(i, 24)
             End If
          End If
        .Cells(i, 26) = .Cells(i, 18) - .Cells(i, 25)
      Next i
  End With
  Application.StatusBar = True
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , ""
End Sub

sunche

hasyh2008 发表于 2022-6-2 15:58
Sub test()
  Application.StatusBar = False
  Application.EnableEvents = False

谢谢老师，我上周六已经解决了，再次感谢！你的代码中 grrq = int(Application.WorksheetFunction.Days360(Range("p" & i), Range("r2"))/30)除以30取整了！这个地方不能取整，取整的话，累计折旧额就不对了！对不起，我没有学分，不能为你评分！

果冻的心

sunche 发表于 2022-6-5 11:22
谢谢老师，我上周六已经解决了，再次感谢！你的代码中 grrq = int(Application.WorksheetFunction.Days36 ...

可以给大佬设置成最佳也是可以的

sunche

果冻的心 发表于 2022-6-5 22:59
可以给大佬设置成最佳也是可以的

好的！