SuperBond

Olá, tenho um note Lenovo Z460 há vários anos. Sempre foi um bom note, mas ha algum tempo a imagem passou a ficar embaralhada, o cursor do mouse fica duplicado, aliás fica todos icones ficam duplicados na tela de modo que eu nem sei onde estou clicando. Anexei uma foto e abaixo  um link de um video que fiz que mostra a situação.  Tirando o problema da tela, ele está normal.

https://www.4shared.com/video/oP3eWnZSei/monitor.html

Sim, claro que atendeu. Desculpe se te fiz perder tempo, apenas esqueci de considerar  o detalhe. De qualquer forma, obrigado. Tentarei fazer adaptações aqui. 

4 horas atrás, Patropi disse:

Boa tarde SuperBond

 

Sem utilizar macros, apenas com formula, copie e cole a formula abaixo na célula U1 e arraste até a linha necessária.

 

=SE(DESLOC(Q$1;MOD(LIN()-1;7);INT((LIN()-1)/7))=0;"";DESLOC(Q$1;MOD(LIN()-1;7);INT((LIN()-1)/7)))

 

Se quiser retirar as formulas, depois você pode copiar/colar/especial/valores

 

Se foi útil, clique em Curtir.

 

Editando: Considerei na mesma planilha, mas funciona também em outra planilha, bastando para isso identificar a planilha na formula.

 

[]s

Obrigado. Usei sua formula, mas ela copia inclusive celulas vazias e não é essa a intenção. Estou tentando pôr uma condição para não copiar celulas vazias. Veja que na figura na coluna U estão celulas intercaladas por vazias. O ideal seria como está na coluna X.

Aproveitando, como identifico a outra planilha na formula?

Em 12/25/2016 às 01:25, DJunqueira disse:

você poderia resolver isso facilmente com Nova Consulta sem usar macro alguma, mas p/ isso você deverá ter o Excel 2010 ou superior com o suplemento do Power Query instalado (já vem nativo na versão 2016).

OK Já tenho o Excel 2010. Então vou adquirir o Power Query.

Gostaria de saber como criar uma macro que copie dados de uma planilha para outra, mas una esses dados numa só coluna. Desta forma:

Em uma planilha chamada Plan2 estariam os itens de 3 colunas, separados. A quantidade de itens eu controlo digitando a quantidade em uma celula e a macro trabalharia com esse numero de itens.

Em uma planilha chamada Plan3, resulta os mesmos itens, só que unidos em uma mesma coluna, conforme a segunda figura.

Ok, obrigado. Eu estava tentando com procv, mas vou usar essa formula.

O objetivo da macro é encontrar indices da coluna PROD RECEB que sejam iguais aos da coluna PROD ALMOX. Encontrando, ele deve marcar 1, na coluna B, na linha correspondente ao indice encontrado. Por exemplo na figura digamos que o 81 e o 240 estejam na PROD RECEB e na PROD ALMOX, então ele marca 1 nas linhas correspondentes.

Os errros que acontecem:

- na depuração apontava "erro de definição de aplicativo ou de definição de objeto" em cells(m, 1) e em cells(n, 3); 

- indicava indices que não estão na coluna PROD ALMOX; 

- só funcionava certo quando a coluna PROD ALMOX tinha menos indices, até uns 20;

- agora ele apresenta um erro de compilação que não consigo identificar;

Estou mandando a planilha em que a macro é aplicada. ALMOXARIFADO.xlsx

Sub indices_almox()
Dim m As Long
Dim n As Long
[T:T].ClearContents
Sheets("almox").Activate
 For m = 2 To 29463 
  For n = 2 To cells(2, 5)
     If Cells(m, 1) = Cells(n, 3) Then
        Cells(m + 1, 2) = "1": m = m + 1
     End If
  Next n
 Next m
End Sub

Boa noite, preciso que os dados na coluna Q apareçam na coluna R, sem duplicatas. Existe o botão remover duplicatas, mas o processo irá se repetir muitas vezes e toma tempo. Preciso de uma fórmula na coluna R que automatize a remoção.

Bom dia, gostaria de evitar o risco de executar uma macro na planilha errada e alterar dados importantes dessa planilha. Por exemplo, a macro a seguir deve ser somente executada na planilha 1, de nome "começo", pois essa planilha já contem os dados certos nas células certas. Essa macro é só um exemplo, não é para funcionar.

Se por engano ela for executada na planilha 2 ou 3, irá apagar dados das coluna A, B e C e retornar o resultado tambem na coluna indevida.

Gostaria de garantir que a macro seja executada somente na planilha 1. 

'ESTA MACRO FORNCE O COMEÇO
'****** USAR NA PLANILHA "começo" ******
Sub produto_começo()
Dim u As Long, m As Long, j As Long, n As Long, r As Long, t As Long
[A:A].ClearContents
[B:B].ClearContents
[C:C].ClearContents
For m = 1 To Cells(1, 2) 'qt M
 For j = 1 To Cells(2, 2) 'qt N
  For n = 1 To Cells(3, 2) 'qt H
  If Cells(m, 13) = Cells(j, 14) Then
    Cells(u + 2, 16) = FIN: u = u + 1  'coluna J
  End If
  Next n
 Next j
Next m
End Sub

Já estou resolvendo o problema em VBA, com a ajuda de outro forista. De qualquer forma, obrigado.

Estou usando writeln( d[3], d[4]) e está funcionando sem o Ord. Agora apenas preciso descobrir uma forma correta de aninhar os While not eof, porque são 3 arquivos a trabalhar.  

O código deixou de fazer, por exemplo, M8M8R4SX, M8M8R4S0, M84W4W4W, W3M8R4H9, entre outras que são válidas. E fez combinações invalidas, como já vimos.

Outra coisa é que, sempre que executa a macro, ele não apaga os resultados anteriores, ele escreve a partir dos anteriores, dando a impressão de que há mais resultados do que deveria, mas isso eu resolvi colocando um ClearContents no início, logo depois do cabeçalho.

[L:L].ClearContents

Na verdade o código formou combinações inválidas e me parece que deixou de formar combinações válidas, mas por hoje estou encerrando o trabalho. Vou deixar um print onde tracei a formação da combinação M8M8R4H9, que sim, é válida. A lógica é sempre a mesma.

@Alpheratz

Me parece que o código está fazendo combinações inválidas. Conforme mostro em amarelo no print, nas colunas correspondentes do COD3 não tem o par 0UQA e nem R48I, então ele não poderia fazer 4W0UQA e 22R48I. Testei apenas com numeros e também ocorrem combinações inválidas.

Agora sim hem phera.  Obrigado 

Um dia desenvolvo sozinho...um dia chego lá. Uma última dúvida: tem como rodar a macro estando na janela do Excel mesmo, sem ter que ir na janela do VBA e dar F5? Seria mais prático.  

29 minutos atrás, Simon Viegas disse:

Olá.

 

Analisando superficialmente imagino duas formas:
1-Trata o número como string mesmo;

2-Criando uma "estrutura de seleção" (if). Algo como "se número menor que 10, imprimir um zero 0 antes"

PS: 

Dá para explicar mais ou menos como funcionar essa estrutura?

N2 := (ord(d[3])-Ord('0'))*10 + ord(d[4])-Ord('0');

Por quê tem que fazer esse -Ord('0') ?

 

 

No aguardo.

Olá,

1)Mas se eu for tratar o numero como string como faria para separar apenas dois algarismos dos demais? Qual função faz isso

2)Escrever o zero antes funciona a principio, mas depois vou fazer algumas comparações entre valores, não sei se funcionaria. O legal seria ter uma forma de trabalhar como string mesmo.

3) Esses calculos com Ord usam o valor ordinal do caracter pelo código ASCII. Veja a explicação nesse tópico: 

http://forum.clubedohardware.com.br/forums/topic/1061675-codigo-em-pascal-para-ler-caracteres-em-linha/

Alpheratz,  eu não consegui implementar suas sugestões no meu código. Tentei de várias formas, menos a certa, claro. Acho que teria aninhar mais Do whiles e Finds para procurar em outras colunas, mas não estou acertando fazer isso.

Estava ate cogitando usar Pascal, que é uma linguagem com a qual tenho mais familiaridade, mas VBA é mais prático e tem mais recursos.  Vou explicar o que preciso: 

Tenho 6 colunas A, B, E, F,  I e J. Tem pares de caracteres em B iguais aos de E e pares caracteres de F iguais aos de I.

Cada duas colunas formam um par: AB, EF e IJ. 

O código precisa unir os pares conforme encontra essas igualdades, ate a ultima linha preenchida. No print voce vê que o que une dois pares de AB ao par de EF é o 09 e o que une EF ao par de IJ é o W4. 

O resultado deve ser:

3209W4ES

X409W4ES

O último código que testei foi esse, só qe o Excel trava com esse código:

Sub Main()
    Dim Linha1           As Long
    Dim LinhaResultado  As Long
    Dim C1 As String, C2 As String, C3 As String, C4 As String, C5 As String, C6 As String
    [L:L].ClearContents
    Linha1 = 2
    Linha2 = 2
    Linha3 = 2
    Linha4 = 2
    Linha5 = 2
    Linha6 = 2
    LinhaResultado = 1
    
    Do While Linha <= Range("B" & Rows.Count).End(xlUp).Row
        C1 = Cells(Linha1, 1).Value
        C2 = Cells(Linha2, 2).Value
        C3 = Cells(Linha3, 5).Value
        C4 = Cells(Linha4, 6).Value
        C5 = Cells(Linha5, 9).Value
        C6 = Cells(Linha6, 10).Value
        
        If Encontrou(C2, Range("E:E")) = True And Encontrou(C4, Range("I:I")) = True Then
            Dim Copia As String
            Copia = Format(C1 & C2 & C4 & N6, String(Len(C1 & C2 & C4 & N6), "0"))
            Cells(LinhaResultado, 12).NumberFormat = "@"
            Cells(LinhaResultado, 12).Value = Copia
            LinhaResultado = LinhaResultado + 1
        End If
        
        Linha1 = Linha1 + 1
        Linha2 = Linha2 + 1
        Linha3 = Linha3 + 1
        Linha4 = Linha4 + 1
        Linha5 = Linha5 + 1
        Linha6 = Linha6 + 1
    Loop
    'ActiveSheet.Range("F:F").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

Function Encontrou(Valor As String, Coluna As Range) As Boolean
    Dim Tmp As String
    
    On Error GoTo Fim
    
    Tmp = Coluna.Find(What:=Valor, LookAt:=xlWhole).Value
    
    Encontrou = True

Fim:
    If Err.Number = 91 Then
        Encontrou = False
    End If
End Function

Preciso que o código leia numeros de um arquivo de texto e mostre os dois últimos algarismos desses números, até o fim do arquivo. Mas o código precisa ler fielmente como está no arquivo. O arquivo N1N2 tem os seguintes numeros:

7199
5087
3209

A saída do código tá sendo:

99

87

  9

Ele está desconsiderando o zero do 09, afinal zero à esquerda se despreza, mas nesse caso, preciso do zero ali. Tem alguma forma de fazer com que ele apresente os 2 últimos algarismos do numero, incluindo o zero?

O código:

Program ULTIMOS;
Uses CRT;
Var
  N2: integer;
  d: string[10];
  N1N2: Text;
Begin
  ClrScr;
  assign(N1N2, 'N1N2.txt'); reset(N1N2);
  While Not eof(N1N2) Do
   Begin
    readln(N1N2, d);
     Begin
          N2 := (ord(d[3])-Ord('0'))*10 + ord(d[4])-Ord('0');
                     writeln(N2);
     End;
   End;
  close(N1N2);
  readln;
End.

Legal. Fiz algumas pequenas alterações, só em relação às colunas com que a macro vai operar. O estranho é que se tem 45 em A e 450 em B ele considera sendo o mesmo valor.

Se tem 045 em A e 450 em B ele faz uma duplicata de um resultado.

O RemoveDuplicates era pra eliminar essa duplicata. O código alterado é esse e o resultado está abaixo e o print dos resultados abaixo: 

Sub Main()
    Dim Linha           As Long
    Dim LinhaResultado  As Long
    Dim Texto           As String
    
    Linha = 1
    LinhaResultado = 1
    
    Do While Linha <= Range("A" & Rows.Count).End(xlUp).Row
        Texto = Cells(Linha, 1).Value
        
        If Encontrou(Texto, Range("B:B")) = True Then
            Dim Copia As String
            Copia = Format(Texto, String(Len(Texto), "0"))
            Cells(LinhaResultado, 6).NumberFormat = "@"
            Cells(LinhaResultado, 6).Value = Copia & Copia
            LinhaResultado = LinhaResultado + 1
        End If
        
        Linha = Linha + 1
    Loop
    'ActiveSheet.Range("F:F").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

Function Encontrou(Valor As String, Coluna As Range) As Boolean
    Dim Tmp As String
    
    On Error GoTo Fim
    
    Tmp = Coluna.Find(Valor).Value
    
    Encontrou = True

Fim:
    If Err.Number = 91 Then
        Encontrou = False
    End If
End Function

10 horas atrás, Alpheratz disse:

Alpheratz funciona, obrigado, só queria entender algumas linhas do código. 

Pode me explicar essa linha? 

Do While Linha <= Range("B" & Rows.Count).End(xlUp).Row

 

E se eu quiser que a macro compare os valores de duas colunas e achando dois iguais ela os escreve juntos como esta na coluna D, como seria o código? Observe que teve 2 itens da col A iguais aos da col B, aí ele escreveu juntos.

Do seu código tentei acrescentar um indice p/ cada celula a ser analisada, mas não teve resultado:

Sub Final()
    Dim Linha   As Long
    Dim LinhaResultado As Long
    Dim N1 As String, N2 As String, N3 As String
    Linha1 = 1
    Linha2 = 1
    LinhaResultado = 1
    
    Do While Linha <= Range("B" & Rows.Count).End(xlUp).Row
        N1 = Cells(Linha1, 2).Value
        N2 = Cells(Linha2, 3).Value
        If N2 = N3 Then
        Cells(LinhaResultado, 16).NumberFormat = "@"
        Cells(LinhaResultado, 16).Value = Format(Val(N1 & N2), String(Len(N1 & N2), "0"))
        End If
        Linha1 = Linha1 + 1
        Linha2 = Linha2 + 1
        LinhaResultado = LinhaResultado + 1
    Loop
End Sub

 

 

 

 

Obrigado, Alpheratz, mas executei sua macro e não aparece nenhum resultado 

Desculpe se pareceu folga minha. Bem, taí um print da pasta e também estou postando a planilha em questão. Os zeros de 09, 05, 08 e 01 tem que permanecer.

AMOSTRA.rar

Ok, estou postando de um celular, então nao posso postar a planilha, mas na planilha, na coluna B tenho os seguinte valores por ex.:

B

96

98

01

02

07

Digamos que eu queira somar 2 a cada um desses valores. O resultado que preciso, nesse caso e':

98

100

03

04

09

Observe que o zero a esquerda foi mantido, e e' isso que eu preciso que aconteca. Mas seu codigo tem saida assim:

98

100

3

4

9

O codigo esta eliminando os zeros. Nao e' isso o esperado.

Ok, só coloquei um End If e ele rodou, mas os dados que estou manipulando estão formatados como texto e alguns valores têm um 0 antes. Assim:

05, 04, 099

E eu preciso que estes zeros estejam no resultado. O código ignora os zeros, trata tudo como número. Está saindo 5, 4, 99 etc

Aí tentei usar Text no Range, mas dá erro 424: O objeto é obrigatorio.

Sub FinalV2()
 Dim m As Range, i As Long
  For Each m In Range("B2", Cells(Rows.Count, "B").End(xlUp)).Text
    If m.Value <> "" Then
     Cells(i + 1, 16) = m.Value: i = i + 1
    End If
  Next m
 'ActiveSheet.Range("P:P").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

Estou tentando fazer uma macro na qual ela verificará os valores em uma coluna e fará certas operações com esses valores. Inicialmente eu tinha feito uma estrutura com For e Next(abaixo),

Sub Final()
Dim m As Long, n As Long, N2 As String
 For m = 2 To 61
      N1 = Cells(m, 2)
       Cells(i + 1, 16) = N1: i = i + 1
  Next m
 ActiveSheet.range("P:P").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

mas como a quantidade de valores nas colunas irá sempre variar, não é prático ficar trocando o valor final da variável  m. Eu preciso que a macro verifique automaticamente até a última célula preenchida. Tentei fazer usando a estrutura Do While Loop, mas o resultado não é o desejado, ela não escreve todos os valores, mas vai tipo escrevendo um e apagando o anterior, é até difícil de explicar. O código com Do While Loop:

Sub Final()
Dim m As Long, n As Long, N1 As String
 m = 2
 N1 = 2
 Do While N1 <> Empty
       Cells(i + 1, 16) = N1: i = i + 1
 m = m + 1
 ActiveSheet.range("P:P").RemoveDuplicates Columns:=1, Header:=xlNo
Loop
End Sub