Usuário com melhor resposta
Função com Referência Circular

Pergunta
-
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 FunctionPorém minha função continua dando erro
Respostas
-
FAVOR MARCAR COMO RESPONDIDO
Anderson Diniz diniabr2011@gmail.com
- Marcado como Resposta Mario Antonini sexta-feira, 10 de novembro de 2017 12:38
-
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 diniabr2011@gmail.com
- Marcado como Resposta Mario Antonini sexta-feira, 10 de novembro de 2017 12:31
-
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 diniabr2011@gmail.com
- Marcado como Resposta Mario Antonini sexta-feira, 10 de novembro de 2017 12:30
Todas as Respostas
-
FAVOR MARCAR COMO RESPONDIDO
Anderson Diniz diniabr2011@gmail.com
- Marcado como Resposta Mario Antonini sexta-feira, 10 de novembro de 2017 12:38
-
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"
-
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 diniabr2011@gmail.com
- Marcado como Resposta Mario Antonini sexta-feira, 10 de novembro de 2017 12:31
-
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 diniabr2011@gmail.com
- Marcado como Resposta Mario Antonini sexta-feira, 10 de novembro de 2017 12:30