Ir ao conteúdo
  • Cadastre-se

Excel Algorítimo para Visual Basic paraExcel


Posts recomendados

Em 17/09/2019 às 18:40, olliver.soul disse:

@Marcela da Silva de Souza  Coloca o código original em C++, acho que fica mais fácil te ajudar a adaptar para VBA a partir dele.

Código em C++

#include <stdio.h>
#include <conio.h>
#include <windows.h>
void gotoxy_2(int x, int y){/*imprimir na linha e coluna desejada */
  COORD c;
  c.X = x;
  c.Y = y;
  SetConsoleCursorPosition (GetStdHandle(STD_OUTPUT_HANDLE), c);
}
int main(){
    int i,j,q,t,r,w,x,y,px,py,vet[12],cont=0;
    FILE *arq=fopen("Minhas Combinacoes.txt","w");
    for(j=0;j<12;j++){
        do{
            printf("%2d%c numero ",j+1,167);
            q=0;
            scanf("%d",&vet[j]);
            if(vet[j]<1 || vet[j]>99)q=1;
            for(r=0;r<12;r++)
                if(vet[j]==vet[r] && j != r )q=1;
        }while( q );
    }
    for(j=0;j<11;j++)
        for(w=j+1;w<12;w++)
            if( vet[j]> vet[w]){
                t     = vet[j] ;
                vet[j]= vet[w] ;
                vet[w]= t      ;
            }
    printf("\n");
    fprintf(arq,"%s","combinações com esses números  --> ");/* grava no arquivo no bloco de notas */
    HANDLE hOut;                              /* controle dos dispositivos do pc                  */
    hOut= GetStdHandle(STD_OUTPUT_HANDLE);    /* pega a saída padrão                              */
    CONSOLE_SCREEN_BUFFER_INFO SBInfo;        /* informações sobre a buffer da tela               */
    GetConsoleScreenBufferInfo(hOut, &SBInfo);/* pega a posição do cursor do console              */
    px = SBInfo.dwCursorPosition.X;           /* pX será a posição da coluna do cursor no console */
    py = SBInfo.dwCursorPosition.Y;           /* pY será a posição da linha do cursor no console  */
    for(j=0;j<12;j++){
        y=vet[j]%10;
        x=vet[j]/10;
        gotoxy_2(px,py);
        if(x%2==0)printf("P" );else printf("I" );
        if(y%2==0)printf("P ");else printf("I ");
        gotoxy_2(px,py+1);                      /* pula para a linha de baixo                       */
        px+=3;
        printf("%d ",vet[j]);/* imprime na tela do pc */
        fprintf(arq,"|%d| ",vet[j]);/* grava no arquivo */
    }
    printf("\n\n     tecle\n\n");
    fprintf(arq,"%s","\n\n");
    getch();
    for(i=0;i<6;i++){
        for(j=i+1;j<12;j++){
            for(q=j+1;q<12;q++){
                for(r=q+1;r<12;r++){
                    for(t=r+1;t<12;t++){
                        for(w=t+1;w<12;w++){
                            cont++;
                            printf("%4d -> %d - %d - %d - %d - %d - %d\n"     ,
                            cont,vet[i],vet[j],vet[q],vet[r],vet[t],vet[w])   ;
                            fprintf(arq,"%4d -> %d - %d - %d - %d - %d - %d\n",
                            cont,vet[i],vet[j],vet[q],vet[r],vet[t],vet[w])   ;
                            /*if(cont==23){cont=-1;printf("   Tecle\n");getch();}*/
                        }
                    }
                }
            }
        }
    }
    printf("\nTotal De Cartoes => %d\n",cont);
    fprintf(arq,"%s%d","\nTotal de cartões => ",cont);
    fclose(arq);
    printf("\n\nAbra O Bloco De notas e abra esse arquivo --> ");
    printf("(  Minhas Combinacoes  )\n"                        );
    printf("Que esta na mesma pasta desse programa\n\n\n"      );
    return 0;
}
 

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

@Marcela da Silva de Souza Não implementei função para gravar em arquivo e também não verifiquei a consistência dos dados, mas acho que já dá pra ter uma ideia de como adaptar as instruções. Segue o código,

 

Sub Main()
    Dim i, j, q, t, r, w, x, y, px, py, vet(12), cont As Integer
    
    i = 0: j = 0: q = 0: t = 0: r = 0: w = 0: x = 0: y = 0: cont = 0: px = 0: py = 0
    
    For j = 0 To 12
        Do
            vet(j) = InputBox("Numero " & j + 1)
            q = 0
            
            If vet(j) < 1 Or vet(j) > 99 Then q = 1
        
            For r = 0 To 12
                If vet(j) = vet(r) And j <> r Then q = 1
            Next r
        
        Loop While q <> 0
    Next j

    For j = 0 To 11
        For w = j + 1 To 12
            If vet(j) > vet(w) Then
                t = vet(j)
                vet(j) = vet(w)
                vet(w) = t
            End If
        Next w
    Next j
    
    px = 1
    py = 1
        
    For j = 0 To 12
        y = vet(j) Mod 10
        x = vet(j) / 10
            
        Cells(px, py).Select
            
        If x Mod 2 = 0 Then
            ActiveCell = "p"
        Else
            ActiveCell = "I"
        End If
            
        If y Mod 2 = 0 Then
            ActiveCell = "p"
        Else
            ActiveCell = "I"
        End If
            
        Cells(px, py + 1).Select
            
        px = px + 3
            
        ActiveCell = vet(j)
    Next j
    
    i = 0: j = 0: q = 0: t = 0: r = 0: w = 0: x = 0: y = 0: cont = 0: px = 0: py = 0
            
    For i = 0 To 6
        For j = i + 1 To 12
            For q = j + 1 To 12
                For t = r + 1 To 12
                    For w = t + 1 To 12
                        cont = cont + 1
                        ActiveCell.Offset(3) = cont & ", " & vet(i) & ", " & vet(j) & ", " & vet(q) & ", " & vet(r) & ", " & vet(t) & ", " & vet(w)
                    Next w
                Next t
            Next q
        Next j
    Next i

    ActiveCell.Offset(6) = "Total de Cartões =>" & cont
End Sub

 

  • Curtir 1
  • Obrigado 1
Link para o comentário
Compartilhar em outros sites


Imports System
Imports Microsoft.VisualBasic

Private Sub Cells(ByVal x As Integer, ByVal y As Integer) 'imprimir na linha e coluna desejada
  Dim c As New COORD()
  c.X = x
  c.Y = y
  SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), c)
End Sub
Shared Function Main() As Integer
	Dim i As Integer
	Dim j As Integer
	Dim q As Integer
	Dim t As Integer
	Dim r As Integer
	Dim w As Integer
	Dim x As Integer
	Dim y As Integer
	Dim px As Integer
	Dim py As Integer
	Dim vet(11) As Integer
	Dim cont As Integer =0
	Dim arq As FILE =fopen("Minhas Combinacoes.txt","w")
	For j = 0 To 11
		Do
			Console.Write("{0,2:D}{1} numero ",j+1,167)
			q = 0
			Dim tempVar As String = ConsoleInput.ScanfRead()
			If tempVar IsNot Nothing Then
				vet(j) = Integer.Parse(tempVar)
			End If
			If vet(j)<1 OrElse vet(j)>99 Then
				q = 1
			End If
			For r = 0 To 11
				If vet(j) = vet(r) AndAlso j <> r Then
					q = 1
				End If
			Next r
		Loop While q <> 0
	Next j
	For j = 0 To 10
		For w = j+1 To 11
			If vet(j)> vet(w) Then
				t = vet(j)
				vet(j) = vet(w)
				vet(w) = t
			End If
		Next w
	Next j
	Console.Write(vbLf)
	fprintf(arq,"%s","combinações com esses números  --> ") ' grava no arquivo no bloco de notas
	Dim hOut As IntPtr ' controle dos dispositivos do pc
	hOut = GetStdHandle(STD_OUTPUT_HANDLE) ' pega a saída padrão
	Dim SBInfo As New CONSOLE_SCREEN_BUFFER_INFO() ' informações sobre a buffer da tela
	GetConsoleScreenBufferInfo(hOut, SBInfo) ' pega a posição do cursor do console
	px = SBInfo.dwCursorPosition.X ' pX será a posição da coluna do cursor no console
	py = SBInfo.dwCursorPosition.Y ' pY será a posição da linha do cursor no console
	For j = 0 To 11
    Cells(j + 1, 1) = vet(j)
  Next
		y = vet(j) Mod 10
		x = vet(j)\10
		gotoxy_2(px, py)
		If x Mod 2=0 Then
		Dim Vetor(11)   As String 	
dig_1 = Left( Vetor(i), 1)' Atribui o primeiro algarismo
dig_2 = Right(Vetor(i), 2)' Atribui o segundo  algarismo
        
If(dig_1 Mod 2  = 0) And (dig_2 Mod 2  = 0) Then PP = PP + 1
If(dig_1 Mod 2  = 0) And (dig_2 Mod 2 <> 0) Then PI = PI + 1
If(dig_1 Mod 2 <> 0) And (dig_2 Mod 2 <> 0) Then II = II + 1
If(dig_1 Mod 2 <> 0) And (dig_2 Mod 2  = 0) Then IP = IP + 1


		Cells(px, py+1) ' pula para a linha de baixo
		px+=3
		Console.Write("{0:D} ",vet(j)) ' imprime na tela do pc
		fprintf(arq,"|%d| ",vet(j)) ' grava no arquivo
	Next j
	Console.Write(vbLf & vbLf & "     tecle" & vbLf & vbLf)
	fprintf(arq,"%s",vbLf & vbLf)
	Console.ReadKey(True)
	For i = 0 To 11
		For j = i+1 To 11
			For q = j+1 To 11
				For r = q+1 To 11
					For t = r+1 To 11
						For w = t+1 To 11
							cont += 1
							Console.Write("{0,4:D} -> {1:D} - {2:D} - {3:D} - {4:D} - {5:D} - {6:D}" & vbLf, cont,vet(i),vet(j),vet(q),vet(r),vet(t),vet(w))
							fprintf(arq,"%4d -> %d - %d - %d - %d - %d - %d" & vbLf, cont,vet(i),vet(j),vet(q),vet(r),vet(t),vet(w))
							'if(cont==23){cont=-1;printf("   Tecle\n");getch();}
						Next w
					Next t
				Next r
			Next q
		Next j
	Next i
	Dim MyVar
fprintf =(vbLf & "Total De Cartoes => %d" & vbLf,cont)

fprintf(arq,"%s%d",vbLf & "Total de cartões => ",cont)
	fclose(arq)
	Console.Write(vbLf & vbLf & "Abra O Bloco De notas e abra esse arquivo --> ")
	Console.Write("(  Minhas Combinacoes  )" & vbLf)
	Console.Write("Que esta na mesma pasta desse programa" & vbLf & vbLf & vbLf)
MsgBox ("Aqui Estão Os Resultados")
End Sub

Gente, boa noite estou tentando converter  esse código porém estou com muita dificuldades em substituir o gotoxy

 esse acima é meu código para  VBA olha o jeito que meu código ficou estou tentando e estudando aquí sei que está horrível mas estou aprendendo, sendo que o que eu preciso é:

 

Mostrar números PP, PI, II, IP

Esses números deverão se subtrair entre si sendo uqe números que tiverem 0 serão contados como dezena como 10 ex: 

02,        04

10-2= 8 10-4= 6...E tem mais funções

 

E ainda tem que ter função de contar a quantidade de cada categoria PP,PI,II,IP ex:

PP= 30

PI= 28

II= 27

IP= 10

E mostrar qual categoria que obteve mais números ex:

PP= 30

Essas são as funções básicas além de ter a função para que o usuário possa digitar de 6 a 15 números dependendo do jogo e escolha dele. Esses são os comandos básicos.

 

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

1 minuto atrás, olliver.soul disse:

@Marcela da Silva de Souza Esse código que você está postando não é do VBA.

 

Chegou a testar o código que eu converti?

Estou abrindo o desenvolvedor.É  porque estava tentando passar para VBA, estou aprendendo agora esse formato vou testar seu código☺️

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

Sub Main()
    Dim i, j, q, t, r, w, x, y, px, py, vet(12), cont As Integer
    
    i = 0: j = 0: q = 0: t = 0: r = 0: w = 0: x = 0: y = 0: cont = 0: px = 0: py = 0
    
    For j = 0 To 12
        Do
            vet(j) = InputBox("Numero " & j + 1)
            q = 0
            
            If vet(j) < 1 Or vet(j) > 99 Then q = 1
        
            For r = 0 To 12
                If vet(j) = vet(r) And j <> r Then q = 1
            Next r
        
        Loop While q <> 0
    Next j

    For j = 0 To 11
        For w = j + 1 To 12
            If vet(j) > vet(w) Then
                t = vet(j)
                vet(j) = vet(w)
                vet(w) = t
            End If
        Next w
    Next j
    
    px = 1
    py = 1
        
    For j = 0 To 12
        y = vet(j) Mod 10
        x = vet(j) / 10
            
        Cells(px, py).Select
            
        If x Mod 2 = 0 Then
         
Dim Vetor(6)   As String 	
dig_1 = Left( Vetor(i), 1)' Atribui o primeiro algarismo
dig_2 = Right(Vetor(i), 2)' Atribui o segundo  algarismo
        
If(dig_1 Mod 2  = 0) And (dig_2 Mod 2  = 0) Then PP = PP + 1
If(dig_1 Mod 2  = 0) And (dig_2 Mod 2 <> 0) Then PI = PI + 1
If(dig_1 Mod 2 <> 0) And (dig_2 Mod 2 <> 0) Then II = II + 1
If(dig_1 Mod 2 <> 0) And (dig_2 Mod 2  = 0) Then IP = IP + 1

        Cells(px, py + 1).Select
            
        px = px + 3
            
        ActiveCell = vet(j)
    Next j
    
    i = 0: j = 0: q = 0: t = 0: r = 0: w = 0: x = 0: y = 0: cont = 0: px = 0: py = 0
            
    For i = 0 To 6
        For j = i + 1 To 12
            For q = j + 1 To 12
                For t = r + 1 To 12
                    For w = t + 1 To 12
                        cont = cont + 1
                        ActiveCell.Offset(3) = cont & ", " & vet(i) & ", " & vet(j) & ", " & vet(q) & ", " & vet(r) & ", " & vet(t) & ", " & vet(w)
                    Next w
                Next t
            Next q
        Next j
    Next i

    ActiveCell.Offset(6) = "Total de Cartões =>" & cont
End Sub

Boa tarde gente estou tentando acrescentei função PP,PI, IP e II,mais faltam outras o código não foi todo convertido colega Olliver.Soul?

  • Obrigado 1
Link para o comentário
Compartilhar em outros sites

@Marcela da Silva de Souza Fiz várias correções no código que converti e acrescentei a função de escrever no arquivo.

 

O arquivo COMBINACAO.TXT será criado no mesmo diretório que a planilha estiver salva

 

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")
        Cells(1, iColuna) = sTipo
        Cells(2, iColuna) = iVetor(J)
        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

 

Exemplo de saída com os números: 45,13,11,22,25,36,80,90,77,88,99,10

 

captura.png.d86138bc4482e3b542158911c8535311.png

 

Primeiros 10 registros do arquivo COMBINACAO.TXT

 

1 -> 10 - 11 - 13 - 22 - 25 - 36
2 -> 10 - 11 - 13 - 22 - 25 - 45
3 -> 10 - 11 - 13 - 22 - 25 - 77
4 -> 10 - 11 - 13 - 22 - 25 - 80
5 -> 10 - 11 - 13 - 22 - 25 - 88
6 -> 10 - 11 - 13 - 22 - 25 - 90
7 -> 10 - 11 - 13 - 22 - 25 - 99
8 -> 10 - 11 - 13 - 22 - 36 - 45
9 -> 10 - 11 - 13 - 22 - 36 - 77
10 -> 10 - 11 - 13 - 22 - 36 - 80

 

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

Será como faz para colocar total de PP,PI, II, e IP ou simplesmente o que caiu mais ex:

 

|Categoria com mais números|

|PI______________________|

|20______________________| Um exemplo mais ou menos. Ou simplesmente a cor da célula se destacar.

adicionado 3 minutos depois

E naquele código em c++ tem a função de subtração de números entre eles mesmos ou estou enganada? 🤔 eu gostaria de passar essa função para VBA também.

Link para o comentário
Compartilhar em outros sites

1 hora atrás, olliver.soul disse:

@Marcela da Silva de Souza  Para pegar a quantidade você pode usar a fórmula CONT.SE,

 

1183541402_CapturadeTela(7).png.a52e06872c847c03cb7b63c6a6bda2ee.png

 

No código em C não tem função de subtração

 

Eu posso juntar as fórmulas normais do Excel na planilha normal mesmo que tenha VBA? Como por exemplo para contar o número maior assim: =MÁXIMO(célula inicial:célula final). Posso inserir normalmente ? Se puder é muito bom!

Link para o comentário
Compartilhar em outros sites

- 1 Step 2
		If vet(j)<10 Then
			Console.Write("0{0:D} , ",vet(j))
		Else
			Console.Write("{0:D} , ",vet(j))
		End If
		If vet(j+1)<10 Then
			Console.Write("0{0:D}" & vbLf,vet (j+1))
		Else
			Console.Write("{0:D}" & vbLf,vet (j+1))
		End If
Next j
	Console.Write(vbLf & "Resultado Da Subtracao" & vbLf)
	For j = 0 To Tm - 1
		num = CInt(Math.Truncate(vet(j)))\10
		resto = vet(j) Mod 10

	  If resto=0 Then
		  resto=10
	  End If
	  If num =0 Then
		  num=10
	  End If

		result = Math.Abs(resto - num)
		Console.Write("{0,3:D} - {1,3:D} => {2,3:D}" & vbLf,resto,num,result)
	Next j
	Console.Write(vbLf & vbLf)
	Console.ReadKey(True)
	Return 0
}

Será que esse trecho de código funcionará a função de subtração entre o número irá se subtrair por ele mesmo? Abaixo segue o trecho do código original em C++, não sei se passei para VBA corretamente... Tô em dúvida

 

 

for(j=0;j<Tm;j+=2){
        if(vet[j]<10)  printf("0%d , ",vet[j]  );
        else           printf( "%d , ",vet[j]  );
        if(vet[j+1]<10)printf("0%d\n",vet [j+1]);
        else           printf( "%d\n",vet [j+1]);
    }
    printf("\nResultado Da Subtracao\n");
    for(j=0;j<Tm;j++){
        num    = (int)vet[j]/10;
        resto  = vet[j] % 10   ;

      if(resto==0)resto=10;
      if(num  ==0)num=10;

        result = abs  (resto - num ) ;
        printf("%3d - %3d => %3d\n",resto,num,result);
    }
    printf("\n\n");
    getch();
    return 0;
}

Link para o comentário
Compartilhar em outros sites

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

não sei se passei para VBA corretamente... Tô em dúvida

Não vai rodar porque isso não é VBA. No VBA por exemplo não tem o comando "Console.Write".

 

Segue o código com a função de subtração, veja se é isso.

 

Os resultados vão para a linha 3.

 

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

Para pegar o maior valor, segue uma sugestão com fórmula. Mas se tiver valor repetido o primeiro será apresentado.

 

captura.png.c454afd5929244e6b6be67766f2579d9.png

  • Curtir 1
Link para o comentário
Compartilhar em outros sites

Olá estou com uma dúvida a respeito do usabilidade.Pois se ele quiser colocar qualquer quantidade de números que ele quiser tipo, menos doque está programado lá.Lá no código mostra 12 números e se quiser colocar 7 números fica um quadro com botão OK que não fecha até digitar o último número.Professor quer que seja a escolha do usuário .Será que tem uma função que faz isso a escolha do usuário sem precisar que fique toda hora atualizando o código?

Link para o comentário
Compartilhar em outros sites

@Marcela da Silva de Souza  Tem sim, é só colocar um inputbox para pedir a quantidade de números e redimensionar o vetor em tempo de execução assim,

 

Sub Main()
    Dim I, J, N, T, R, W    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
        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 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
                            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

Mas dependendo da quantidade de números, talvez tenha que rever esses loops/For para escrever no arquivo. Com 5 números por exemplo não chega no último loop.

 

E o range da fórmula que conta PP, IP, etc também tem que ser editado.

 

  • Curtir 2
Link para o comentário
Compartilhar em outros sites

Em 22/09/2019 às 20:41, olliver.soul disse:

@Marcela da Silva de Souza  Tem sim, é só colocar um inputbox para pedir a quantidade de números e redimensionar o vetor em tempo de execução assim,

 


Sub Main()
    Dim I, J, N, T, R, W    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
        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 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
                            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

Mas dependendo da quantidade de números, talvez tenha que rever esses loops/For para escrever no arquivo. Com 5 números por exemplo não chega no último loop.

 

E o range da fórmula que conta PP, IP, etc também tem que ser editado.

 

Oi, boa noite então como fica tenho que Digitar mais For  ? Não entendi sobre o range.

adicionado 55 minutos depois

É desse jeito assim para mostrar os números até no final?

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



 

Link para o comentário
Compartilhar em outros sites

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

Oi, boa noite então como fica tenho que Digitar mais For  ? Não entendi sobre o range.

adicionado 55 minutos depois

É desse jeito assim para mostrar os números até no final?

 

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)

 

  • Curtir 2
Link para o comentário
Compartilhar em outros sites

5 horas atrás, 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)

 

Olá boa tarde, é isso mesmo que o professor quer, independente do que o usuário colocar, deve ter um comando para finalizar o programa na hora que o usuário quiser.  

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

Essa fórmula que está acima já soluciona o problema?

Link para o comentário
Compartilhar em outros sites

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

Olá boa tarde, é isso mesmo que o professor quer, independente do que o usuário colocar, deve ter um comando para finalizar o programa na hora que o usuário quiser.  

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

Essa fórmula que está acima já soluciona o problema?

A dúvida em relação aqueles loops permanece.

 

Por que o programa cria um arquivo com 5 colunas dos números e diversas combinações? Tem que ser 5 colunas?

 

Por que o código original por exemplo começa com for(i=0;i<6;i++)? E quanto aos demais loops que vem depois? Tem que fazer alguma alteração no código dependendo da quantidade de números que o usuário escolher?

 

A fórmula está solucionada, é só colocar nas células D6:D9.

Link para o comentário
Compartilhar em outros sites

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
Em 24/09/2019 às 16:05, olliver.soul disse:

A dúvida em relação aqueles loops permanece.

 

Por que o programa cria um arquivo com 5 colunas dos números e diversas combinações? Tem que ser 5 colunas?

 

Por que o código original por exemplo começa com for(i=0;i<6;i++)? E quanto aos demais loops que vem depois? Tem que fazer alguma alteração no código dependendo da quantidade de números que o usuário escolher?

 

A fórmula está solucionada, é só colocar nas células D6:D9.Pré-visualizar

 

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário 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 comunidades 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

×
×
  • Criar novo...