Midori

Dá pra com macro, Esse código por exemplo soma os valores de A1 de todas as planilhas Sub Prog() Dim Wks As Worksheet Dim C As Currency For Each Wks In ThisWorkbook.Worksheets C = C + Wks.Range("A1") Next Wks MsgBox C End Sub

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.

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)

No campo que está reservado (O31) deve aparece a foto só do candidato com a maior quantidade de votos?

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

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.

@Marcela da Silva de Souza Para pegar a quantidade você pode usar a fórmula CONT.SE, No código em C não tem função de subtração

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

@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? Obs: Fiz uma edição depois que postei

@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

@Marcela da Silva de Souza Sugeri colocar/postar o código original aqui no tópico...

@Caio Rodrigues Almeida Deve estar faltando alguma declaração de variável. Tipo isso, Dim WksSolicitacao As Worksheet Set WksSolicitacao = ThisWorkbook.Worksheets("SOLICITAÇÃO")

@Marcela da Silva de Souza Para apresentar os dados na planilha você pode usar Cells(linha, coluna).

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

@Marcela da Silva de Souza Esse último código que você postou não vai rodar no VBA/Excel. E ele tem vários recursos: manipula arquivos, tem bubble sort, etc. Seu programa precisa dessas funções? E você precisa converter isso para o VBA/Excel? O que precisa ser adaptado? Você está tentando adaptar o último código que eu postei com esse? Se sim, o que falta?

Testei em um compilador online e rodou sem erro... Talvez quem use o CodeBlocks tenha alguma dica.

Remova o & do scanf da string. Na leitura de strings não há necessidade de usar esse operador.. Além disso use float para os valores. Feito isso veja se resolve.

Post ignorado

Sem vetor pode ser assim, Sub Prog() Dim sAlg As String Dim iAlg_1, iAlg_2 As Integer Dim PP, PI, II, IP As Integer Dim i As Integer PP = 0: PI = 0: II = 0: IP = 0 For i = 0 To 5 sAlg = InputBox("Elemento n° " & i + 1) iAlg_1 = Left(sAlg, 1) iAlg_2 = Right(sAlg, 1) If (iAlg_1 Mod 2 = 0) And (iAlg_2 Mod 2 = 0) Then PP = PP + 1 If (iAlg_1 Mod 2 = 0) And (iAlg_2 Mod 2 <> 0) Then PI = PI + 1 If (iAlg_1 Mod 2 <> 0) And (iAlg_2 Mod 2 <> 0) Then II = II + 1 If (iAlg_1 Mod 2 <> 0) And (iAlg_2 Mod 2 = 0) Then IP = IP + 1 Next i MsgBox "PP = " & PP & vbNewLine & _ "PI = " & PI & vbNewLine & _ "II = " & II & vbNewLine & _ "IP = " & IP & vbNewLine End Sub Mas se o exercício pedir algo a mais, acho que você de adaptar o código.

Para verificar todas as planilhas é só usar For...Each com Worksheet. Exemplo, Dim WksPlanilha As Worksheet For Each WksPlanilha In ThisWorkbook.Worksheets MsgBox WksPlanilha.Name Next WksPlanilha Aí é só colocar seu código para procurar (com Find) no loop.

@Marcela da Silva de Souza Para contar dessa forma é só atribuir os algarismos separadamente e verificar na condicional se é par ou ímpar. Por exemplo, Dim sVetor(6) As String ' Atribui o primeiro algarismo iAlg_1 = Left(sVetor(i), 1) ' Atribui o segundo algarismo iAlg_2 = Right(sVetor(i), 1) If (iAlg_1 Mod 2 = 0) And (iAlg_2 Mod 2 = 0) Then PP = PP + 1 If (iAlg_1 Mod 2 = 0) And (iAlg_2 Mod 2 <> 0) Then PI = PI + 1 Obs: Se for só para contar PP, PI, etc nem precisa usar vetor/array.

Fiz um teste e acho que dessa forma não vai ficar tão prático. Segue outro código com a função Find. Testei na planilha Controle e deu certo, acho que assim fica mais fácil. Sub Lançar() Dim WksControle As Worksheet Dim Proximo As Range Set WksControle = ThisWorkbook.Worksheets("CONTROLE") Set Proximo = WksControle.Range("B:B").Find("") Proximo.PasteSpecial _ Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, _ Transpose:=False End Sub No caso da planilha solicitação, é só fazer uma pequena alteração no argumento da função, exemplo Set Proximo = WksSolicitacao.Range("B:B").Find("", WksSolicitacao.Range("B6"))

Para facilitar segue um código simples de ser editado. Sub Prog() Dim iVetor(6) As Integer Dim i As Integer Dim iContaPar As Integer For i = 0 To 5 iVetor(i) = InputBox("Elemento n° " & i + 1 & " do vetor: ") If iVetor(i) Mod 2 = 0 Then iContaPar = iContaPar + 1 End If Next i MsgBox "Par = " & iContaPar End Sub

Com VBA pode ser assim, no Módulo EstaPastaDeTrabalho Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Range("A1") = Application.UserName End Sub

Para executar a macro automaticamente pode ser questão de usar o evento correto. Seu código está sendo ativando em Worksheet_Change, Já tentou com Worksheet_Calculate?