Excel Algorítimo para Visual Basic paraExcel

Midori · 25 de setembro de 2019

7 horas atrás, Marcela da Silva de Souza disse:

que o menu poderia ter um comando para o usuário fechar aquela caixa de opções sem que ele ou ela mecha no código

No último código o usuário já escolhe a quantidade de números que vai digitar, então não precisa criar uma opção para sair.

Mas se quiser colocar essa opção, você criar uma regra para fechar a caixa se o usuário digitar 0 por exemplo.

Ou então no lugar do InputBox criar um formulário com o botão Sair.

Marcela da Silva de Souza · 26 de setembro de 2019

Em 25/09/2019 às 09:42, olliver.soul disse:

No último código o usuário já escolhe a quantidade de números que vai digitar, então não precisa criar uma opção para sair.

Mas se quiser colocar essa opção, você criar uma regra para fechar a caixa se o usuário digitar 0 por exemplo.

Ou então no lugar do InputBox criar um formulário com o botão Sair.

Marcela da Silva de Souza · 27 de setembro de 2019

E preciso fazer a soma dos números um pelos outros igualmente como eu fiz com subtrações.

Sub Main()
    Dim I, J, N, T, R, W    As Integer
    Dim iVetor(12), iConta  As Integer
    Dim iColuna, iArq, x, y As Integer
    Dim sTipo               As String
    
    iConta = 0
    iColuna = 3
    iArq = FreeFile
       
    Open ThisWorkbook.Path & "\COMBINACOES.TXT" For Output As iArq
    
    For J = 0 To 11
        Do
            iVetor(J) = InputBox("Numero " & J + 1)
            N = 0
            
            If iVetor(J) < 1 Or iVetor(J) > 99 Then N = 1
        
            For R = 0 To 12
                If iVetor(J) = iVetor(R) And J <> R Then N = 1
            Next R
        Loop While N
    Next J
    
    For J = 0 To 10
        For W = J + 1 To 11
            If iVetor(J) > iVetor(W) Then
                T = iVetor(J)
                iVetor(J) = iVetor(W)
                iVetor(W) = T
            End If
        Next W
    Next J

    For J = 0 To 11
        x = Int(iVetor(J) / 10)
        y = Int(iVetor(J) Mod 10)
        sTipo = IIf(x Mod 2 = 0, "P", "I")
        sTipo = sTipo & IIf(y Mod 2 = 0, "P", "I")
        
        If x = 0 Then x = 10
        If y = 0 Then y = 10
        
        R = Abs(y - x)
        
        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)
        Cells(3, iColuna) = y & "-" & x & "=" & R
        
        iColuna = iColuna + 1
    Next J
    
    For I = 0 To 5
        For J = I + 1 To 11
            For N = J + 1 To 11
                For R = N + 1 To 11
                    For T = R + 1 To 11
                        For W = T + 1 To 11
                            iConta = iConta + 1
                            Print #iArq, _
                                iConta & " -> " & iVetor(I) & " - " & _
                                iVetor(J) & " - " & iVetor(N) & " - " & _
                                iVetor(R) & " - " & iVetor(T) & " - " & iVetor(W)
                        Next W
                    Next T
                Next R
            Next N
        Next J
    Next I
    
    Close #iArq
   
    Cells(4, 3) = "Total de Cartões =>" & iConta
End Sub

Usar código acima:

adicionado 11 minutos depois

Em 24/09/2019 às 09:46, olliver.soul disse:

Os loops/For que me refiro são aqueles aninhados no final e que tem a função de escrever no arquivo.

Seu professor pediu assim?

Confirme o que o programa deve fazer dependendo da quantidade de números... Se tiver poucos por exemplo 4 ou 5 números.

A fórmula é o CONT.SE, mas você pode resolver isso aumentando o range até a última coluna

=CONT.SE($C$1:$XFD$1;C6)

Em 24/09/2019 às 16:05, olliver.soul disse:

Midori · 28 de setembro de 2019

Em 27/09/2019 às 15:30, Marcela da Silva de Souza disse:

E preciso fazer a soma dos números um pelos outros igualmente como eu fiz com subtrações.

É só somar x com y.

Marcela da Silva de Souza · 3 de outubro de 2019

Em 28/09/2019 às 16:54, olliver.soul disse:

É só somar x com y.

Boa noite é só fazer assim como vou colocar no código

Sub Main()
    Dim I, J, N, T, R, W    As Integer
    Dim iVetor(12), iConta  As Integer
    Dim iColuna, iArq, x, y As Integer
    Dim sTipo               As String
    
    iConta = 0
    iColuna = 3
    iArq = FreeFile
       
    Open ThisWorkbook.Path & "\COMBINACOES.TXT" For Output As iArq
    
    For J = 0 To 11
        Do
            iVetor(J) = InputBox("Numero " & J + 1)
            N = 0
            
            If iVetor(J) < 1 Or iVetor(J) > 99 Then N = 1
        
            For R = 0 To 12
                If iVetor(J) = iVetor(R) And J <> R Then N = 1
            Next R
        Loop While N
    Next J
    
    For J = 0 To 10
        For W = J + 1 To 11
            If iVetor(J) > iVetor(W) Then
                T = iVetor(J)
                iVetor(J) = iVetor(W)
                iVetor(W) = T
            End If
        Next W
    Next J

    For J = 0 To 11
        x = Int(iVetor(J) / 10)
        y = Int(iVetor(J) Mod 10)
        sTipo = IIf(x Mod 2 = 0, "P", "I")
        sTipo = sTipo & IIf(y Mod 2 = 0, "P", "I")
        
        If x = 0 Then x = 10
        If y = 0 Then y = 10
        
        R = Abs(y + x)
        
        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)
        Cells(3, iColuna) = y & "-" & x & "=" & R
        
        iColuna = iColuna + 1
    Next J
    
    For I = 0 To 5
        For J = I + 1 To 11
            For N = J + 1 To 11
                For R = N + 1 To 11
                    For T = R + 1 To 11
                        For W = T + 1 To 11
                            iConta = iConta + 1
                            Print #iArq, _
                                iConta & " -> " & iVetor(I) & " - " & _
                                iVetor(J) & " - " & iVetor(N) & " - " & _
                                iVetor(R) & " - " & iVetor(T) & " - " & iVetor(W)
                        Next W
                    Next T
                Next R
            Next N
        Next J
    Next I
    
    Close #iArq
   
    Cells(4, 3) = "Total de Cartões =>" & iConta
End Sub

Porém está dando erro de caminho.

Midori · 3 de outubro de 2019

15 horas atrás, Marcela da Silva de Souza disse:

Porém está dando erro de caminho.

É preciso salvar a planilha pelo menos uma vez antes de rodar a macro.

Ou então editar o caminho nessa parte,

Open ThisWorkbook.Path & "\COMBINACOES.TXT" For Output As iArq

Marcela da Silva de Souza · 4 de outubro de 2019

8 horas atrás, olliver.soul disse:

É preciso salvar a planilha pelo menos uma vez antes de rodar a macro.

Ou então editar o caminho nessa parte,

Open ThisWorkbook.Path & "\COMBINACOES.TXT" For Output As iArq

Está certo o jeito que eu fiz? no código? Ainda está subtraindo e agora não pergunta a quantidade de número que o usuário quer colocar.

Midori · 4 de outubro de 2019

9 horas atrás, Marcela da Silva de Souza disse:

Está certo o jeito que eu fiz? no código? Ainda está subtraindo e agora não pergunta a quantidade de número que o usuário quer colocar.

Esse não é o último código que eu postei.

O que pergunta a quantidade de números tem a variável iNumeros.

Marcela da Silva de Souza · 5 de outubro de 2019

Em 04/10/2019 às 08:50, olliver.soul disse:

Esse não é o último código que eu postei.

O que pergunta a quantidade de números tem a variável iNumeros.

Okm.A parte de somar os números não está dando certo somei X com y não deu

Midori · 5 de outubro de 2019

25 minutos atrás, Marcela da Silva de Souza disse:

Okm.A parte de somar os números não está dando certo somei X com y não deu

Rodei o último código que você postou e esse foi o resultado,

Está somando os algarismos. Não é assim?

Marcela da Silva de Souza · 5 de outubro de 2019

3 horas atrás, olliver.soul disse:

Rodei o último código que você postou e esse foi o resultado,

Está somando os algarismos. Não é assim?

Será que é por causa da versão do meu Excel 7 será que é isso?

adicionado 35 minutos depois

4 horas atrás, olliver.soul disse:

Rodei o último código que você postou e esse foi o resultado,

Está somando os algarismos. Não é assim?

Tem alguma função para verficar sequência de números repetidos em um intervalo de tempo exemplo:

Concurso 4005-1 2 4 6 8 10 11 12 24 27 28 30*

Concurso-4006-3 5 6 7 9 11 15 17 23 25 30

Concurso 4007-1 2 4 6 8 10 11 12 24 27 28 30*

Intervalo- 1 jogo Concurso 4007

Eu encontrei uma fórmula no Excel, mas será que tem no VBA?

Midori · 6 de outubro de 2019

22 horas atrás, Marcela da Silva de Souza disse:

Será que é por causa da versão do meu Excel 7 será que é isso?

Tem que dar o mesmo resultado. Crie uma nova planilha, copie novamente esse último o código e faça outro teste.

22 horas atrás, Marcela da Silva de Souza disse:

Eu encontrei uma fórmula no Excel, mas será que tem no VBA?

Qual fórmula?

Marcela da Silva de Souza · 7 de outubro de 2019

1 hora atrás, olliver.soul disse:

Tem que dar o mesmo resultado. Crie uma nova planilha, copie novamente esse último o código e faça outro teste.

Qual fórmula?

=CONTA-SES e a

=MOD

Patropi · 7 de outubro de 2019

@Marcela da Silva de Souza

Para responder use a janela de resposta que fica logo abaixo da última resposta, não use o botão citar sem necessidade, pois fica poluindo o fórum com a cópia da última resposta.

[]s

Marcela da Silva de Souza · 16 de outubro de 2019

Em 06/10/2019 às 21:00, Marcela da Silva de Souza disse:

=CONTA-SES e a

=MOD

Bomais dia será que alguém sabe passar essa fórmula de Excel o V BA só estou conseguindo assim

Midori · 16 de outubro de 2019

@Marcela da Silva de Souza No VBA, MOD é um operador. Exemplo de uso: If X Mod 2 = 0 Then

E o CONTA.SES é WorksheetFunction.CountIfs

Marcela da Silva de Souza · 17 de outubro de 2019

15 horas atrás, olliver.soul disse:

@Marcela da Silva de Souza No VBA, MOD é um operador. Exemplo de uso: If X Mod 2 = 0 Then

E o CONTA.SES é WorksheetFunction.CountIfs

Boa noite mas para mostrar o intervalo de números tipo na planilha mostrar

Em 05/10/2019 às 20:56, Marcela da Silva de Souza disse:

Será que é por causa da versão do meu Excel 7 será que é isso?

adicionado 35 minutos depois

Tem alguma função para verficar sequência de números repetidos em um intervalo de tempo exemplo:

Concurso 4005-1 2 4 6 8 10 11 12 24 27 28 30*

Concurso-4006-3 5 6 7 9 11 15 17 23 25 30

Concurso 4007-1 2 4 6 8 10 11 12 24 27 28 30*

Intervalo- 1 jogo Concurso 4007

Eu encontrei uma fórmula no Excel, mas será que tem no VBA?

?

Marcela da Silva de Souza · 19 de outubro de 2019

Tem como colocar a função subtração e soma na mesma planilha, mas em células diferentes?

Marcela da Silva de Souza · 23 de outubro de 2019

Boa noite como faço para implementar no código uma função para que X e y somem e subtraia na mesma planilha.

Midori · 23 de outubro de 2019

10 horas atrás, Marcela da Silva de Souza disse:

Boa noite como faço para implementar no código uma função para que X e y somem e subtraia na mesma planilha.

Você pode editar essa parte,

        R = Abs(y + x)
        
        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)
        Cells(3, iColuna) = y & "-" & x & "=" & R

E deixar assim,

        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)

        Cells(3, iColuna) = y & "-" & x & "=" & Abs(y - x)
        Cells(4, iColuna) = y & "+" & x & "=" & y + x

Marcela da Silva de Souza · 24 de outubro de 2019

12 horas atrás, olliver.soul disse:

Você pode editar essa parte,


        R = Abs(y + x)
        
        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)
        Cells(3, iColuna) = y & "-" & x & "=" & R

E deixar assim,


        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)

        Cells(3, iColuna) = y & "-" & x & "=" & Abs(y - x)
        Cells(4, iColuna) = y & "+" & x & "=" & y + x

adicionado 1 minuto depois

A parte de baixo é continuação da de cima?Eu já entreguei o trabalho quero aprender mesmo com vocês agora.

Midori · 24 de outubro de 2019

8 horas atrás, Marcela da Silva de Souza disse:

A parte de baixo é continuação da de cima?Eu já entreguei o trabalho quero aprender mesmo com vocês agora.

A parte de baixo é para substituir a de cima.

Nas linhas 3 e 4 eu já faço a subtração e soma direto sem usar a variável R.

Marcela da Silva de Souza · 20 de novembro de 2019

Em 24/10/2019 às 08:11, olliver.soul disse:

A parte de baixo é para substituir a de cima.

Nas linhas 3 e 4 eu já faço a subtração e soma direto sem usar a variável R.

Em 02/10/2019 às 23:35, Marcela da Silva de Souza disse:

Boa noite é só fazer assim como vou colocar no código


Sub Main()
    Dim I, J, N, T, R, W    As Integer
    Dim iVetor(12), iConta  As Integer
    Dim iColuna, iArq, x, y As Integer
    Dim sTipo               As String
    
    iConta = 0
    iColuna = 3
    iArq = FreeFile
       
    Open ThisWorkbook.Path & "\COMBINACOES.TXT" For Output As iArq
    
    For J = 0 To 11
        Do
            iVetor(J) = InputBox("Numero " & J + 1)
            N = 0
            
            If iVetor(J) < 1 Or iVetor(J) > 99 Then N = 1
        
            For R = 0 To 12
                If iVetor(J) = iVetor(R) And J <> R Then N = 1
            Next R
        Loop While N
    Next J
    
    For J = 0 To 10
        For W = J + 1 To 11
            If iVetor(J) > iVetor(W) Then
                T = iVetor(J)
                iVetor(J) = iVetor(W)
                iVetor(W) = T
            End If
        Next W
    Next J

    For J = 0 To 11
        x = Int(iVetor(J) / 10)
        y = Int(iVetor(J) Mod 10)
        sTipo = IIf(x Mod 2 = 0, "P", "I")
        sTipo = sTipo & IIf(y Mod 2 = 0, "P", "I")
        
        If x = 0 Then x = 10
        If y = 0 Then y = 10
        
        R = Abs(y + x)
        
        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)
        Cells(3, iColuna) = y & "-" & x & "=" & R
        
        iColuna = iColuna + 1
    Next J
    
    For I = 0 To 5
        For J = I + 1 To 11
            For N = J + 1 To 11
                For R = N + 1 To 11
                    For T = R + 1 To 11
                        For W = T + 1 To 11
                            iConta = iConta + 1
                            Print #iArq, _
                                iConta & " -> " & iVetor(I) & " - " & _
                                iVetor(J) & " - " & iVetor(N) & " - " & _
                                iVetor(R) & " - " & iVetor(T) & " - " & iVetor(W)
                        Next W
                    Next T
                Next R
            Next N
        Next J
    Next I
    
    Close #iArq
   
    Cells(4, 3) = "Total de Cartões =>" & iConta
End Sub

Porém está dando erro de caminho.

Boa noite, eu gostaria de saber apesar de eu já ter entregue meu trabalho.Pois na parte que eu não consegui fazer não tive pontuação no trabalho.Era o seguinte, era para determinar intervalo entre sequência de números ex:

1-01 02 06 10 13 20

2-04 07 15 16 19 30

3-05 08 17 28 34 50

4-01 02 06 10 13 20

Repetição de sequência de números: 1* grupo e 4* .Nesse exemplo mostrou que a sequência de números se repetiu na quarta linha.Então ela poderia ser mesclada para mostrar em qual linha essa sequência se repetiria com os mesmos números ou pelo menos parte deles.

Tentei aplicar fórmula no Excel CONTA SES porém ele queria em vBA não consegui.Como será que aplico no codigo poderiam me explicar: E também gostaria de saber se posso colocar 2 macros na mesma planilha

Marcela da Silva de Souza · 6 de maio de 2020

Bom dia gente, esse código está dando erro de compilação preciso de compila lo alguém ajuda?

Sub Main()
    Dim I, J, N, T, R, W    As Integer
    Dim iVetor(12), iConta  As Integer
    Dim iColuna, iArq, x, y As Integer
    Dim sTipo               As String
    
    iConta = 0
    iColuna = 3
    iArq = FreeFile
       
    Open ThisWorkbook.Path & "\COMBINACOES.TXT" For Output As iArq
    
    For J = 0 To 11
        Do
            iVetor(J) = InputBox("Numero " & J + 1)
            N = 0
            
            If iVetor(J) < 1 Or iVetor(J) > 99 Then N = 1
        
            For R = 0 To 12
                If iVetor(J) = iVetor(R) And J <> R Then N = 1
            Next R
        Loop While N
    Next J
    
    For J = 0 To 10
        For W = J + 1 To 11
            If iVetor(J) > iVetor(W) Then
                T = iVetor(J)
                iVetor(J) = iVetor(W)
                iVetor(W) = T
            End If
        Next W
    Next J

    For J = 0 To 11
        x = Int(iVetor(J) / 10)
        y = Int(iVetor(J) Mod 10)
        sTipo = IIf(x Mod 2 = 0, "P", "I")
        sTipo = sTipo & IIf(y Mod 2 = 0, "P", "I")
        
        If x = 0 Then x = 10
        If y = 0 Then y = 10
        
        R = Abs(y - x)
        
        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)
        Cells(3, iColuna) = y & "-" & x & "=" & R
        
        iColuna = iColuna + 1
    Next J
    
    For I = 0 To 5
        For J = I + 1 To 11
            For N = J + 1 To 11
                For R = N + 1 To 11
                    For T = R + 1 To 11
                        For W = T + 1 To 11
                            iConta = iConta + 1
                            Print #iArq, _
                                iConta & " -> " & iVetor(I) & " - " & _
                                iVetor(J) & " - " & iVetor(N) & " - " & _
                                iVetor(R) & " - " & iVetor(T) & " - " & iVetor(W)
                        Next W
                    Next T
                Next R
            Next N
        Next J
    Next I
    
    Close #iArq
   
    Cells(4, 3) = "Total de Cartões =>" & iConta
End Sub

E eu gostaria que juntasse as funções dele com esse outro código que escolhe a quantidade que o usuário quer:

Sub Main()
    Dim I, J, N, T, R, W, Z    As Integer
    Dim iVetor()            As Integer
    Dim iColuna, iArq, x, y As Integer
    Dim iNumeros            As Integer
    Dim iConta              As Long
    Dim sTipo               As String
    
    iConta = 0
    iColuna = 3
    iArq = FreeFile
       
    Open ThisWorkbook.Path & "\COMBINACOES.TXT" For Output As iArq
    
    iNumeros = InputBox("Entre com a quantidade de números")
    
    ReDim iVetor(iNumeros)
    
    iNumeros = iNumeros - 1
        
    For J = 0 To iNumeros
        Do
            iVetor(J) = InputBox("Numero " & J + 1)
            N = 0
            
            If iVetor(J) < 1 Or iVetor(J) > 99 Then N = 1
        
            For R = 0 To iNumeros
                If iVetor(J) = iVetor(R) And J <> R Then N = 1
            Next R
        Loop While N
    Next J
    
    For J = 0 To iNumeros - 1
        For W = J + 1 To iNumeros
            If iVetor(J) > iVetor(W) Then
                T = iVetor(J)
                iVetor(J) = iVetor(W)
                iVetor(W) = T
            End If
        Next W
    Next J
    
    For J = 0 To iNumeros - 1
        For Z = J + 1 To iNumeros
            If iVetor(J) > iVetor(Z) Then
                T = iVetor(J)
                iVetor(J) = iVetor(Z)
                iVetor(Z) = R
            End If
        Next Z
    Next J
    
    
    For J = 0 To iNumeros
        x = Int(iVetor(J) / 10)
        y = Int(iVetor(J) Mod 10)
        sTipo = IIf(x Mod 2 = 0, "P", "I")
        sTipo = sTipo & IIf(y Mod 2 = 0, "P", "I")
        
        If x = 0 Then x = 10
        If y = 0 Then y = 10
        
        R = Abs(y - x)
        
        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)
        Cells(3, iColuna) = y & "-" & x & "=" & R
        
        iColuna = iColuna + 1
    Next J
    
    For I = 0 To 6
        For J = I + 1 To iNumeros
            For N = J + 1 To iNumeros
                For R = N + 1 To iNumeros
                    For T = R + 1 To iNumeros
                        For W = T + 1 To iNumeros
                          For Z = T + 1 To iNumeros
                            iConta = iConta + 1
                                Print #iArq, _
                                iConta & " -> " & iVetor(I) & " - " & _
                                iVetor(J) & " - " & iVetor(N) & " - " & _
                                iVetor(R) & " - " & iVetor(T) & " - " & iVetor(W) - " & iVetor(W)"
                        
                        
                
                          Next Z
                        Next W
                    Next T
                Next R
            Next N
        Next J
    Next I
    
    Close #iArq
   
    Cells(4, 3) = "Total de Cartões =>" & iConta
End Sub

adicionado 1 minuto depois

Motivo: vou para a roça longe de internet e civilização rsrsrs

adicionado 5 minutos depois

Ou melhor o primeiro código tá dando erro de execução