Função definida pelo usuário

[SuperBond]

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:

 

 

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.

[Visitante]

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

[SuperBond]

@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.

 

 

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:

 

 

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

[Visitante]

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