- 28 Jul 2017 às 22:43
#25115
Saudações.
Tenho o seguinte código:
Public ss As String
Sub Combinações(Optional v As Variant) 'nome da macro é combinação setando a matriz v como variante
Dim n As Integer, m As Integer 'seta a quantidade elementos como número inteiro
n = Application.CountA(Range("A2:XFD2")) 'conta quantidade de números para gerar combinações
If IsMissing(v) Then 'v sendo ausente executa o redimensionamento da matriz na quantidade máxima de 1000 elementos
ReDim v(1000) As Variant
For i = 0 To n - 1 'inicia a captura dos números digitados para a matriz
v(i) = Cells(2, i + 1)
Next
End If
ReDim Preserve v(1 To n) 'redimensiona a matriz para a quantidade máxima de elementos digitados
m = [a4] 'alimente a variável m com a a quantidade de elementos em cada combinação
If m > n Then Exit Sub 'se o número de elementos para combinação for maior que a quantidade de elementos é encerrado a macro
If Application.Combin(n, m) > 100000 Then 'cálcula quantas combinações são possíveis e encerra a macro se foram maior que 100 mil
MsgBox "Serão mais de 100000 combinações, a programação será encerrada"
Exit Sub
End If
ss = "" 'variável ss serve para fazer a junção da combinação
Range("5:5").ClearContents 'seleciona o cabeçalho das combinações e apaga
For i = 1 To m
Cells(5, i) = "Nº " & i 'cria novos cabeçalhos com a quantidade exata dos elementos
Next
Cells(5, i) = "Junção"
Rows("6:1000006").ClearContents 'exclui dados antigos caso existam
Range("A6").Select 'marca a celula inicial que receberá os dados
Comb2 n, m, 1, "", v 'chama a macro Comb2 setando a algumas variáveis e mantendo outras
End Sub
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m > n - k + 1 Then Exit Sub 'se o número de elementos para combinação for maior que a quantidade de elementos é encerrado a macro
If m = 0 Then 'quando m for igual a 0 inicia a montagem das combinações
v1 = Split(Replace(Trim(s), "'", ""), " ") 'v1 armazena a posição que serão recuperados da matriz
sss = "" 'sss assim como ss são utilizadas para a junção dos números da combinação
For i = LBound(v1) To UBound(v1) 'loop da matriz v1 que possui o endereço do elemento da matriz v
sss = sss & v(v1(i)) & " " 'inicia a junção da combinação para apresentar na coluna Junção
ActiveCell.Offset(0, i) = v(v1(i)) 'imprime o primeiro número da combinação na célula A6 sendo incrementada a cada loop
Next
ActiveCell.Offset(0, [a4]) = sss 'imprime na coluna junção os número concatenados
ActiveCell.Offset(1, 0).Select 'seleciona um nova lina
ss = ss & sss & vbNewLine 'limpa conteúdo das variáveis ss e sss
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v 'incrementa as variáveis m utilizada para dar start nas combinações e variável s que armazena o caminho dos elementos da matriz
Comb2 n, m, k + 1, s, v 'quando elimina cada bloco de combinação reinicia a Macro Comb2 até que m seja maior que n
End Sub
Já tenho ele funcionando em uma planilha e gerando as combinações que preciso, porém, desejo é ocultar a pasta onde a Macro Roda e colocar um botão em outra pasta. Para executar essa Macro, porém mantendo a pasta onde ela está oculta. Tentei alguns códigos que encontrei pela rede em outros fóruns, vídeos, etc... porém sem sucesso.
Poderiam me auxiliar na tarefa?
Agradeço a atenção.
Tenho o seguinte código:
Public ss As String
Sub Combinações(Optional v As Variant) 'nome da macro é combinação setando a matriz v como variante
Dim n As Integer, m As Integer 'seta a quantidade elementos como número inteiro
n = Application.CountA(Range("A2:XFD2")) 'conta quantidade de números para gerar combinações
If IsMissing(v) Then 'v sendo ausente executa o redimensionamento da matriz na quantidade máxima de 1000 elementos
ReDim v(1000) As Variant
For i = 0 To n - 1 'inicia a captura dos números digitados para a matriz
v(i) = Cells(2, i + 1)
Next
End If
ReDim Preserve v(1 To n) 'redimensiona a matriz para a quantidade máxima de elementos digitados
m = [a4] 'alimente a variável m com a a quantidade de elementos em cada combinação
If m > n Then Exit Sub 'se o número de elementos para combinação for maior que a quantidade de elementos é encerrado a macro
If Application.Combin(n, m) > 100000 Then 'cálcula quantas combinações são possíveis e encerra a macro se foram maior que 100 mil
MsgBox "Serão mais de 100000 combinações, a programação será encerrada"
Exit Sub
End If
ss = "" 'variável ss serve para fazer a junção da combinação
Range("5:5").ClearContents 'seleciona o cabeçalho das combinações e apaga
For i = 1 To m
Cells(5, i) = "Nº " & i 'cria novos cabeçalhos com a quantidade exata dos elementos
Next
Cells(5, i) = "Junção"
Rows("6:1000006").ClearContents 'exclui dados antigos caso existam
Range("A6").Select 'marca a celula inicial que receberá os dados
Comb2 n, m, 1, "", v 'chama a macro Comb2 setando a algumas variáveis e mantendo outras
End Sub
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m > n - k + 1 Then Exit Sub 'se o número de elementos para combinação for maior que a quantidade de elementos é encerrado a macro
If m = 0 Then 'quando m for igual a 0 inicia a montagem das combinações
v1 = Split(Replace(Trim(s), "'", ""), " ") 'v1 armazena a posição que serão recuperados da matriz
sss = "" 'sss assim como ss são utilizadas para a junção dos números da combinação
For i = LBound(v1) To UBound(v1) 'loop da matriz v1 que possui o endereço do elemento da matriz v
sss = sss & v(v1(i)) & " " 'inicia a junção da combinação para apresentar na coluna Junção
ActiveCell.Offset(0, i) = v(v1(i)) 'imprime o primeiro número da combinação na célula A6 sendo incrementada a cada loop
Next
ActiveCell.Offset(0, [a4]) = sss 'imprime na coluna junção os número concatenados
ActiveCell.Offset(1, 0).Select 'seleciona um nova lina
ss = ss & sss & vbNewLine 'limpa conteúdo das variáveis ss e sss
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v 'incrementa as variáveis m utilizada para dar start nas combinações e variável s que armazena o caminho dos elementos da matriz
Comb2 n, m, k + 1, s, v 'quando elimina cada bloco de combinação reinicia a Macro Comb2 até que m seja maior que n
End Sub
Já tenho ele funcionando em uma planilha e gerando as combinações que preciso, porém, desejo é ocultar a pasta onde a Macro Roda e colocar um botão em outra pasta. Para executar essa Macro, porém mantendo a pasta onde ela está oculta. Tentei alguns códigos que encontrei pela rede em outros fóruns, vídeos, etc... porém sem sucesso.
Poderiam me auxiliar na tarefa?
Agradeço a atenção.
