none
Função com Referência Circular RRS feed

  • 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 Function

    Porém minha função continua dando erro

    quarta-feira, 8 de novembro de 2017 19:40

Respostas

  • FAVOR MARCAR COMO RESPONDIDO

    Anderson Diniz diniabr2011@gmail.com

    • Marcado como Resposta Mario Antonini sexta-feira, 10 de novembro de 2017 12:38
    quinta-feira, 9 de novembro de 2017 16:57
  • 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
    sexta-feira, 10 de novembro de 2017 12:12
  • 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
    sexta-feira, 10 de novembro de 2017 12:23

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
    quinta-feira, 9 de novembro de 2017 16:57
  • 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"

    quinta-feira, 9 de novembro de 2017 18:20
  • 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
    sexta-feira, 10 de novembro de 2017 12:12
  • 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
    sexta-feira, 10 de novembro de 2017 12:23