Função com Referência Circular

Question

Gostaria de fazer uma função Res=x/y onde eu selecionasse x e y no excel e a função calculasse o resultado e, caso o resultado fosse maior do que 0.15, somar 1 a y até que a função fosse menor do que 0.15, e, caso fosse menor do que 0.12, diminuir 1 de y até que a função fosse maior do que 0.12. Tudo o que consegui até agora foi:

Function Res(x As Long, y As Long)

Res = x / y

If Res > 0.15 Then
Do
y = y + 1
Loop While Res > 0.15

Else:
If Res < 0.12 Then
Do
y = y - 1
Loop While 0.12 > Res

Else: y = y
End If
End If
End Function

Porém minha função continua dando erro

Answer 1

FAVOR MARCAR COMO RESPONDIDO

---

Anderson Diniz [e-mail]

Answer 2

Ok, eu consegui porém não é exatamente o que eu quero.

Private Sub Worksheet_Calculate()
 
 
 If Range("K7").Value > 0.15 Then
 Range("I7") = Range("I7") + 1
 PrevVal = Range("A1").Value
 End If
 
 If Range("K7").Value < 0.12 Then
 Range("I7") = Range("I7") - 1
 End If

End Sub

Eu coloquei em "K7" o resultado de x/y sendo x="B1" e y="I7"

porém eu gostaria que fizesse tudo em um só macro sem precisar do "K7"

Answer 3

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    'SE A CÉLULA SELECIONADA
    'ESTIVER NA COLUNA1 OU 2
    If Target.Column <= 2 Then
        
        'CHAMA O PROCEDIMENTO TESTE
        'target.row é o número da linha da célula selecionada
        Dim CELULAX, CELULAY As Range
        Dim VX, VY As Double
        Dim z As Range
        Set z = ThisWorkbook.Sheets("Dados").Range("I7")
        Set CELULAX = ThisWorkbook.Sheets("Dados").Range("B2")
        Set CELULAY = ThisWorkbook.Sheets("Dados").Range("I7")
        
        VX = CDbl(CELULAX.Value)
      '  VY = CDbl(CELULAY.Value)
      'VAMOS COMEÇAR SEMPRE COM Y VALENDO 0.01
      VY = 0.01
        If Not IsEmpty(VX) And Not IsEmpty(VY) Then
            
            Call teste(z, VX, VY)
        End If
        
        
    End If
    
End Sub

---

Anderson Diniz [e-mail]

Answer 4

Option Explicit

Public Sub teste(ByVal cel As Range, ByVal x As Double, ByVal y As Double)
    
   Dim int1 As Integer
 
    On Error GoTo FIM:
    If x / y > 0.15 Then
        While x / y > 0.15
            y = y + 0.1
            
            
        Wend
         int1 = Application.WorksheetFunction.RoundDown(y, 1)
         ThisWorkbook.Sheets("Dados").Range("I7").Value = int1

    If x / y > 0.15 Then
         ThisWorkbook.Sheets("Dados").Range("I7").Value = CInt(int1 + 1)
         End If
  If x / y < 0.12 Then
         ThisWorkbook.Sheets("Dados").Range("I7").Value = CInt(int1 - 1)
         End If
        Exit Sub
    End If
    
    
    If x / y < 0.12 Then
        While x / y < 0.12
            y = y - 0.1
            
            
        Wend
         int1 = Application.WorksheetFunction.RoundDown(y, 1)
         ThisWorkbook.Sheets("Dados").Range("I7").Value = int1

    If x / y > 0.15 Then
         ThisWorkbook.Sheets("Dados").Range("I7").Value = CInt(int1 + 1)
         End If
  If x / y < 0.12 Then
         ThisWorkbook.Sheets("Dados").Range("I7").Value = CInt(int1 - 1)
         End If
        Exit Sub
    End If
   

    
    
    
FIM:
End Sub

---

Anderson Diniz [e-mail]