Ir ao conteúdo
  • Cadastre-se
SuperBond

Função definida pelo usuário

Recommended Posts

O seguinte código multiplica dois números, n1 e n2, e mostra o resultado.

Function Multiply(n1, n2) As Double   Multiply = n1 * n2End FunctionSub ShowResult()    Dim n1 As Double, n2 As Double    Dim Result As Double    n1 = 12    n2 = 5    Result = Multiply(n1, n2)    MsgBox ResultEnd Sub 

Nesse caso, n1 e n2 são valores únicos.

 

Mas se eu quisesse que fosse:

 

post-565727-0-54339600-1421980566.png

 

Aí n1 e n2 teriam que ser matrizes, teriam índices e a saída seriam as multiplicações de todas combinações possiveis entre n1 e n2: 1*3, 1*4, 1*5 ... até 5*7 . Tudo colocado em uma única coluna.

 

.Fiz as seguintes alterações no código acima:

Function Multiply() As DoubleDim i As Long, j As Long, k As Long For i = 1 To 3   For j = 1 To 3     For k = 1 To 9       Multiply(k, 1) = n1(i, 1) * n2(j, 1)     Next k   Next j Next iEnd FunctionSub ShowResult()    Dim n1(), n2()    Dim Result As Double    Dim i As Long, j As Long    For i = 1 To 3      For j = 1 To 3        For k = 1 To 9          Result = Multiply(n1, n2)        Next k      Next j    Next i    MsgBox ResultEnd Sub

Imagino que tanto a Function quanto a Sub deveriam ter indices, mas não está funcionando, acusa Sub ou Function não definida.

Compartilhar este post


Link para o post
Compartilhar em outros sites

resultado a partir de "P1"

Sub ProdutosCél()  Dim n1 As Long, n2 As Long, k As Long    Columns(16).ClearContents    For n1 = 2 To 6      For n2 = 2 To 6        Cells(k + 1, 16) = Cells(n1, 12) * Cells(n2, 13)        k = k + 1      Next n2    Next n1End Sub

 

utilizando matrizes; resultado a partir de "O1"

Sub ProdutosElemMatrizes()  Dim n1(), n2(), m As Long, k As Long, x As Long    Columns(15).ClearContents    n1 = Range("L2:L6").Value: n2 = Range("M2:M6").Value    For m = LBound(n1) To UBound(n1)      For k = LBound(n2) To UBound(n2)        Cells(x + 1, 15) = n1(m, 1) * n2(k, 1)        x = x + 1      Next k    Next mEnd Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

@osvaldomp

 

obrigado

 

Nesse código abaixo estou usando o comando MID com a intenção de extrair o último algarismo de cada produto AxB ( sempre multiplicando os algarismos da mesma linha).

Se o ultimo algarismo do produto for igual a algum numero na coluna D, então esse algarismo do produto sai na coluna L.

 

post-565727-0-76704800-1422412509.png

 

1 * 4 = 4        último algarismo é 4

4 * 5 = 20      último algarismo é 0

2 * 6 = 12      ultimo algarismo é 2

Sub MultiplicandoAeB()Dim i As Long, k As Long    Columns("L:L").Clear    A = range("A1:A3").Value    B = range("B1:B3").Value    matrizX = range("D1:D3").Value    For i = 1 To 3     For k = 1 To 3      If Mid(A(i, 1) * B(i, 1), 2, 1) = matrizX(k, 1) Then        Cells(x + 1, 12) = Mid(A(i, 1) * B(i, 1), 2, 1): x = x + 1      End If     Next k    Next iEnd Sub

A saida, para A e B da tabela acima, deveria ser:

 

post-565727-0-34524100-1422412024.png

 

Já fiz de tudo que conheço mas não funciona de jeito nenhum.

Compartilhar este post


Link para o post
Compartilhar em outros sites

no comando abaixo:

If Mid(A(i, 1) * B(i, 1), 2, 1) = matrizX(k, 1) Then

1. Mid(valor,2,1) retorna o valor que está na segunda posição, porém no Produto  1*4=4 não existe a segunda posição, então retorna "Nothing"; eu usaria Right(valor,1), que neste caso retornaria 4

2. Mid (e também Right) retorna texto ao passo que matrizX é formada por números, então a comparação entre ambos não é válida; para transformar o resultado de Mid (e também de Right) em número adicione zero ou multiplique por 1:
If Mid(A(i, 1) * B(i, 1), 2, 1) + 0 = matrizX(k, 1) Then
porém, fazendo isso o código irá travar se não houver a segunda posição, pois tentará obter a Soma = "Nothing" + 0; se colocar outro valor no lugar do número 1, por exemplo: 7*4=28 funciona, pois retorna 8, então Soma=8+0

Resumindo: o comando Mid só irá funcionar se "100 > (Produto + 0) > 9" (inteiro), ou seja, Produto deverá ter 2 dígitos e deverá ser transformado em número. Se Produto tiver 3 dígitos Mid irá pegar o do meio e não o último.

experimente o Right:
If Right(A(i, 1) * B(i, 1), 1) + 0 = matrizX(k, 1) Then

dica - declare sempre TODAS as variáveis; no editor de VBA / Ferramentas / Opções / Requerer declaração de variável; em seguida o Excel irá colocar a expressão "Option Explicit" no topo do editor

 

opção:

Sub DireitaProduto()  Dim m As Long, i As Long    [L:L].ClearContents    For m = 1 To 3      If Application.CountIf([D1:D3], Right(Cells(m, 1) * Cells(m, 2), 1)) > 0 Then        Cells(i + 1, 12) = Right(Cells(m, 1) * Cells(m, 2), 1): i = i + 1      End If    Next mEnd Sub



 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×